On Monday 18 November 2013 15:54:03 Ivanko B wrote:
> 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;
"
procedure tmt1inputfo.findindexexec(const sender: TObject);
begin
with qryFindBase do
active:= false; active:= true;
if recordcount = 0 then
may_ok:= false;
showmessage('Данный индекс не найден для данных капмании,
каталога и типа подписки!','ИНДЕКС НЕ НАЙДЕН',200);
else
if recordcount > 1 then
may_ok:= false;
showmessage('Данный индекс имеет дубли для данных капмании,
каталога и типа подписки!','ОШИБКА В ДАННЫХ НА СЕРВЕРЕ',200);
end;
end;
end;
"
looks OK for me.
> ----------------------
> 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;
I would use a table:
"
type
maskmodty = (mm_i,mm_r,mm_s,mm_g,mm_m,mm_x);
maskmodsty = set of maskmodty;
const
modifiers: array[maskmodty] of string = (
//mm_i,mm_r,mm_s,mm_g,mm_m,mm_x
'iI','rR','sS','gG','mM','xX');
var
ch1: char;
mod1: maskmodty;
mask: maskmodsty;
...
mask:= [];
ch1:= amodifiers [i];
for mod1 in maskmodty do
if pos(ch1,modifiers[mod1]) > 0 then
mask:= [mod1];
break;
end;
end;
> ------------------------------------
> 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;
"
while (APtr<AEtx) do
SearchForLineBreak(APtr,AEtx,bol,lng);
SkipLineBreak(APtr,AEtx);
eob1:= MatchBoundary(bol,APtr,ABoundary);
if Assigned(eob1) then
eob2 := MatchLastBoundary(bol,AEtx,ABoundary);
end;
if Assigned(eob2) then
APtr := eob2;
Break;
else
if Assigned(eob1) then
APtr := eob1;
Break;
else
SetString(s,bol,lng);
ALines.Add(s);
end;
end;
end;
"
looks OK for me.
> --------------------
> 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 (value_len < tab_len) then
s1:= avalues[i];
setlength(ar1[i],1); // на выходе столбца будет однострочный массив
ar1[i][0]:= fitstring(s1,tab_len,alignment[i]);
else
if (value_len = tab_len) then
setlength(ar1[i],1); // на выходе столбца будет однострочный массив
ar1[i][0]:= avalues[i];
else
...
end;
end;
"
looks OK for me.
> ----------------------------
if editmode= em_edit then
// редактирование записи
// Проставить дату деактивации текущей записи рабочей таблицы
// (дата активации новой записи)
// редактированная запись деактивируется введенной
// датой активации новой записи
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+');';
else // удаление записи
// удаленная запись деактивируется прямо введенной датой деактивации
asql:= asql+'update '+ref_name+' set date_deactiv='+
fieldtosql(fldDateDeactiv)+' where '+id_field_name+'='+
curr_id + ';';
// если удаленная запись все еще рабочая - активировать ее
if calc_ref_state(fldDateActiv,fldDateDeactiv) then
asql:= asql+'insert into '+bit_name+' (current_record,'+
code_field_name+',ref_state) '+
' values (' + curr_id + ',' + fieldtosql(fieldbyname('code'))+
',' + #39'A'#39 + ');';
end;
end;
end;
end;
end;
"
The problem here are the many comments, I don't think "elseif" makes it any
better.
> ----------------------------------
> 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;
"
if mainfo <> nil then // меняется пароль логина
if seOldPassword.value <> dmmainmo.fldOperPassword.asmsestring then
showmessage('Прежний пароль введен неправильно!')
else
b1:= true;
dmmainmo.dbpasswchange(seNew.value);
end;
else
if loginfo <> nil then // меняется пароль входа в программу
if not md5digestcomp(pswencode(seOldPassword.value),
pswread('admin.psw')) then
showmessage('Прежний пароль введен неправильно!');
else
b1:= true;
pswwrite('admin.psw',pswencode(seNew.value));
end;
end;
end;
"
looks OK for me.
> -----------------------
> 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;
"
procedure clean4notfound(const fieldread, fieldwrite: tfield;
const local_idx_num: integer = -1);
var
bm: bookmarkdataty{string};
fld: tfield;
sr,sw: msestring;
begin
if (fieldread = nil) or (fieldwrite = nil) or
not ((fieldread.dataset.active) and (fieldwrite.dataset.active)) or
(fieldwrite.dataset.state in [dsBrowse,dsInactive]) then
exit;
end;
with d: (dataset as tmsesqlquery) do
if fieldread is tmselongintfield then
if local_idx_num >= 0 then
if not d.indexlocal[local_idx_num].find([fieldwrite.asinteger],[],bm,
false,false,true) then
fieldwrite.clear;
end;
end;
else
if fieldread is tmsestringfield then
if local_idx_num >= 0 then
if not d.indexlocal[local_idx_num].find([fieldwrite.asmsestring],[],bm,
false,false,true) then
fieldwrite.clear;
end;
end;
end;
end;
end;
"
looks OK for me.
> ----------------------------------
> 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;
"
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);
end;
result:= ttextstream.create(outfile,fm_create);
end;
end;
"
looks OK for me.
> ----------------------------
> 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 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;
end;
end;
"
looks OK for me.
> --------------------------
> 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}
"
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');
end;
end;
debugwriteln('qryForm5Single.ApplyRecUpdate : step 1');
{$endif}
"
or
"
{$ifdef DEBUG_SQL}
case updatekind of
ukModify:
debugwriteln('qryForm5Single.ApplyRecUpdate : updatekind is ukModify');
ukInsert:
debugwriteln('qryForm5Single.ApplyRecUpdate : updatekind is ukInsert');
end;
debugwriteln('qryForm5Single.ApplyRecUpdate : step 1');
{$endif}
"
even better. :-)
Martin
------------------------------------------------------------------------------
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
mseide-msegui-talk@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mseide-msegui-talk
