Do You request real code from PODPISKA & ROZNITSA ? OK:
----------------------
procedure tmt1inputfo.findindexexec(const sender: TObject);
begin
with qryFindBase do begin
active:= false; active:= true;
if recordcount = 0 then begin
may_ok:= false;
showmessage('Данный индекс не найден для данных капмании,
каталога и типа подписки!','ИНДЕКС НЕ НАЙДЕН',200);
end else if recordcount > 1 then begin
may_ok:= false;
showmessage('Данный индекс имеет дубли для данных капмании,
каталога и типа подписки!','ОШИБКА В ДАННЫХ НА СЕРВЕРЕ',200);
end;
end;
end;
----------------------
REGEXPR
class function TRegExpr.ParseModifiersStr (const AModifiers : RegExprString;
var AModifiersInt : integer) : boolean;
// !!! Be carefull - this is class function and must not use object
instance fields
var
i : integer;
IsOn : boolean;
Mask : integer;
begin
Result := true;
IsOn := true;
Mask := 0; // prevent compiler warning
for i := 1 to length (AModifiers) do
if AModifiers [i] = '-'
then IsOn := false
else begin
if Pos (AModifiers [i], 'iI') > 0
then Mask := MaskModI
else if Pos (AModifiers [i], 'rR') > 0
then Mask := MaskModR
else if Pos (AModifiers [i], 'sS') > 0
then Mask := MaskModS
else if Pos (AModifiers [i], 'gG') > 0
then Mask := MaskModG
else if Pos (AModifiers [i], 'mM') > 0
then Mask := MaskModM
else if Pos (AModifiers [i], 'xX') > 0
then Mask := MaskModX
else begin
Result := false;
EXIT;
end;
if IsOn
then AModifiersInt := AModifiersInt or Mask
else AModifiersInt := AModifiersInt and not Mask;
end;
end; { of function TRegExpr.ParseModifiersStr
------------------------------------
SYNAPSE
procedure CopyLinesFromStreamUntilBoundary(var APtr:PANSIChar;
AEtx:PANSIChar; ALines:TStrings; const ABoundary:ANSIString);
var
bol: PANSIChar;
lng: integer;
s: ANSIString;
BackStop: ANSIString;
eob1: PANSIChar;
eob2: PANSIChar;
begin
BackStop := '--'+ABoundary;
eob2 := nil;
// Copying until Boundary will be reached
while (APtr<AEtx) do
begin
SearchForLineBreak(APtr,AEtx,bol,lng);
SkipLineBreak(APtr,AEtx);
eob1 := MatchBoundary(bol,APtr,ABoundary);
if Assigned(eob1) then
eob2 := MatchLastBoundary(bol,AEtx,ABoundary);
if Assigned(eob2) then
begin
APtr := eob2;
Break;
end
else if Assigned(eob1) then
begin
APtr := eob1;
Break;
end
else
begin
SetString(s,bol,lng);
ALines.Add(s);
end;
end;
end;
--------------------
if (value_len < tab_len) then begin
s1:= avalues[i];
setlength(ar1[i],1); // на выходе столбца будет однострочный массив
ar1[i][0]:= fitstring(s1,tab_len,alignment[i]);
end else if (value_len = tab_len) then begin
setlength(ar1[i],1); // на выходе столбца будет однострочный массив
ar1[i][0]:= avalues[i];
end else begin
[...]
----------------------------
if editmode= em_edit then begin // редактирование записи
// Проставить дату деактивации текущей записи
рабочей таблицы
// (дата активации новой записи)
// редактированная запись деактивируется
введенной датой активации
новой записи
asql:= asql + 'update ' + ref_name + ' set
date_deactiv=' +
fieldtosql(fldDateActiv) + ' where ' + id_field_name + '=' + curr_id
+ ';';
// новое ID для текущего кода
new_rec_get(false);
// Вставить новую запись в рабочую таблицу
asql:= asql + 'insert into ' + ref_name + ' ('
+ field_names + ')
values (' + field_values + ');';
// новая запись - рабочая ?
if calc_ref_state(fldDateActiv,fldDateDeactiv)
then // по новому ID
// если новая запись подходит под
активирование - сделать это
asql:= asql + 'insert into ' +
bit_name + ' (current_record,' +
code_field_name + ',ref_state) ' +
' values (' +
fieldtosql(fldID) + ',' +
fieldtosql(fieldbyname('code')) + ',' + #39'A'#39 + ');'
// или же старая запись - рабочая ?
// проверка между деактивацией старой и
активацией новой
else if
calc_ref_state(fldDateActiv,fldDateActiv,true) then // по
старому ID
// если старая запись подходит под
активирование - сделать это
asql:= asql + 'insert into ' + bit_name
+ ' (current_record,' +
code_field_name + ',ref_state) ' +
' values (' + curr_id + ',' +
fieldtosql(fieldbyname('code')) +
',' + #39'A'#39 + ');'
;
end else begin // удаление записи
// удаленная запись деактивируется прямо
введенной датой деактивации
asql:= asql + 'update ' + ref_name + ' set
date_deactiv=' +
fieldtosql(fldDateDeactiv) + ' where ' + id_field_name + '=' +
curr_id + ';';
// если удаленная запись все еще рабочая -
активировать ее
if calc_ref_state(fldDateActiv,fldDateDeactiv)
then begin
asql:= asql + 'insert into ' + bit_name + '
(current_record,' +
code_field_name + ',ref_state) ' +
' values (' + curr_id + ',' +
fieldtosql(fieldbyname('code')) +
',' + #39'A'#39 + ');';
end;
end;
----------------------------------
if mainfo <> nil then begin // меняется пароль логина
if seOldPassword.value <>
dmmainmo.fldOperPassword.asmsestring then
showmessage('Прежний пароль введен неправильно!')
else begin
b1:= true;
dmmainmo.dbpasswchange(seNew.value);
end;
end else if loginfo <> nil then begin // меняется
пароль входа в программу
if not
md5digestcomp(pswencode(seOldPassword.value),pswread('admin.psw'))
then
showmessage('Прежний пароль введен неправильно!')
else begin
b1:= true;
pswwrite('admin.psw',pswencode(seNew.value));
end;
end;
-----------------------
procedure clean4notfound(
const fieldread, fieldwrite: tfield;
const local_idx_num: integer = -1
);
var
bm: bookmarkdataty{string};
fld: tfield;
sr,sw: widestring;
begin
if (fieldread = nil) or (fieldwrite = nil) then exit;
if not ((fieldread.dataset.active) and (fieldwrite.dataset.active)) then exit;
with fieldread, (dataset as tmsesqlquery) do begin
if (fieldwrite.dataset.state in [dsBrowse,dsInactive]) then exit;
if fieldread is tmselongintfield then begin
if local_idx_num >= 0 then begin
if not indexlocal[local_idx_num].find(
[fieldwrite.asinteger],[],bm,
false,false,true
) then begin
fieldwrite.clear;
end;
end;
end else if fieldread is tmsestringfield then begin
if local_idx_num >= 0 then begin
if not indexlocal[local_idx_num].find(
[fieldwrite.asmsestring],[],bm,
false,false,true
) then begin
fieldwrite.clear;
end;
end;
end;
end;
end;
----------------------------------
function GetPSStream( adir: msestring = ''): ttextstream;
begin
if adir = '' then
outfile:= gettempfilename(gettempdir ,'msepsout')
else if finddir(adir) then
outfile:= gettempfilename(adir,'msepsout')
else
raise exception.create('GetPSStream: failed to access the output
directory ' + adir);
result:= ttextstream.create(outfile,fm_create);
end;
----------------------------
procedure tform5edifo.monthbegsettext(const sender: tdataedit;
var atext: msestring; var accept: Boolean);
begin
if ExecRegExpr('^[0-9]+\.[0-9]+$', atext) then
atext:= '01.' + atext
else if ExecRegExpr('^[0-9]+$', atext) then
atext:= '01.' + atext + '.' + IntToStr(YearOf(Today));
end;
--------------------------
procedure tform5singleeditfo.applyrecupdate(const sender: tmsesqlquery;
const updatekind: TUpdateKind; var asql: AnsiString; var done: Boolean);
var
i1: integer;
form6id_sql: ansistring;
s: ansistring;
{$ifdef DEBUG_SQL}
f: text;
{$endif}
begin
{$ifdef DEBUG_SQL}
if updatekind = ukModify then
debugwriteln('qryForm5Single.ApplyRecUpdate : updatekind is
ukModify')
else if updatekind = ukInsert then
debugwriteln('qryForm5Single.ApplyRecUpdate : updatekind is
ukInsert');
debugwriteln('qryForm5Single.ApplyRecUpdate : step 1');
{$endif}
-----------------------------
------------------------------------------------------------------------------
DreamFactory - Open Source REST & JSON Services for HTML5 & Native Apps
OAuth, Users, Roles, SQL, NoSQL, BLOB Storage and External API Access
Free app hosting. Or install the open source package on any LAMP server.
Sign up and see examples for AngularJS, jQuery, Sencha Touch and Native!
http://pubads.g.doubleclick.net/gampad/clk?id=63469471&iu=/4140/ostg.clktrk
_______________________________________________
mseide-msegui-talk mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/mseide-msegui-talk
