Skip to content

Commit

Permalink
Refactoring
Browse files Browse the repository at this point in the history 
Fix for drapid#3
  • Loading branch information
@drapid
drapid committed Jun 12, 2024
1 parent 120c7bc commit b699f9a
Show file tree
Hide file tree
Showing 5 changed files with 330 additions and 214 deletions.
114 changes: 69 additions & 45 deletions scriptLib.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,8 @@ interface
defaultAlias: THashedStringList;
staticVars: THashedStringList; // these scripting variables are held for the whole run-time

function tryApplyMacrosAndSymbols(fs: TFileServer; var txt: String; var md: TmacroData; removeQuotings: Boolean=true): Boolean;
function runScript(fs: TFileServer; const script:string; table:TstringDynArray=NIL; tpl_:Ttpl=NIL; f:Tfile=NIL; folder:Tfile=NIL; cd:TconnDataMain=NIL): String;
function tryApplyMacrosAndSymbols(fs: TFileServer; var txt: UnicodeString; var md: TmacroData; removeQuotings: Boolean=true): Boolean;
function runScript(fs: TFileServer; const script: UnicodeString; table:TstringDynArray=NIL; tpl_:Ttpl=NIL; f:Tfile=NIL; folder:Tfile=NIL; cd:TconnDataMain=NIL): UnicodeString;
function runEventScript(fs: TFileServer; const event: String; table: TStringDynArray=NIL; cd: TconnDataMain=NIL): String;
procedure resetLog();
procedure runTimedEvents(fs: TFileServer);
Expand Down Expand Up @@ -115,23 +115,27 @@ function encodeMarkers(s:string):string;
result:=s;
end; // encodeMarkers

function noMacrosAllowed(s:string):string;
function noMacrosAllowed(s: UnicodeString): UnicodeString;
// prevent hack attempts
var
i: integer;
begin
if s = '' then
Exit('');
i:=1;
enforceNUL(s);
repeat
i:=findMacroMarker(s, i);
if i = 0 then break;
replace(s, '&#'+intToStr(charToUnicode(s[i]))+';', i,i);
i:=findMacroMarker(s, i);
if i = 0 then
break;
replace(s, '&#'+intToStr(charToUnicode(s[i]))+';', i,i);
until false;
s:=reReplace(s,'%([-a-z0-9]+%)','%$1', 'mi');
result:=s;
// s := reReplace(s,'%([-a-z0-9]+%)','%$1', 'mi');
// result:=s;
Result := ReplaceStr(s, '%','%');
end; // noMacrosAllowed

function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData: Pointer): String;
function cbMacros(fs: TFileServer; const fullMacro: UnicodeString; pars: TPars; cbData: Pointer): UnicodeString;
var
md: ^TmacroData;
name, p: string;
Expand Down Expand Up @@ -306,6 +310,20 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
result := pars.ContainsKey(name);
end; // parExist

function parExistVal(const name: String; var val: String; doTrim: boolean=TRUE): boolean;
begin
Result := false;
val := '';
if name > '' then
begin
Result := pars.TryGetValue(name, val);
if Result then
if doTrim then
val := trim(val)
end;
end; // parExistVal


procedure trueIf(condition:boolean);
begin if condition then result:='1' else result:='' end;

Expand Down Expand Up @@ -340,15 +358,15 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
begin result:=getVarSpace(varname).values[varname] end;

// if par with name exists, then it's a var name, otherwise it's a constant value at specified index
function parVar(parname:string; idx:integer):string; overload;
function parVar(const parname: String; idx: Integer): String; overload;
begin
if parExist(parname) then
result:=getVar(par(parname))
else
result:=pars[idx];
end; // parVar

function setVar(varname, value:string; space:THashedStringList=NIL):boolean;
function setVar(varname: String; const value: String; space: THashedStringList=NIL): Boolean;
var
o: Tobject;
i: integer;
Expand Down Expand Up @@ -612,7 +630,7 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
result:=macroQuote(result);
end; // section

function urlVar(k:string):string;
function urlVar(const k: String): String;
var
s: string;
begin
Expand All @@ -629,10 +647,12 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
except end;
end; // urlVar

function maybeUrlvar(k:string):string;
function maybeUrlvar(const k: String): String;
begin
if (k = '') or (k[1] <> '?') then result:=k
else result:=urlvar(copy(k,2,MAXINT));
if (k = '') or (k[1] <> '?') then
result := k
else
result := urlvar(copy(k,2,MAXINT));
end; // maybeUrlvar

function compare(op,p1,p2:string):boolean;
Expand Down Expand Up @@ -669,7 +689,7 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
end;
end; // infixOperators

procedure call(code:string; ofs:integer=0);
procedure call(const code: String; ofs: Integer=0);
var
i: integer;
begin
Expand Down Expand Up @@ -823,9 +843,10 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:

if p = 'virtual' then
begin
name:=par(1);
if not validateAndExtractParent() then exit;
f:=Tfile.createVirtualFolder(fs.rootFile.mainTree, name);
name:=par(1);
if not validateAndExtractParent() then
exit;
f := Tfile.createVirtualFolder(fs.rootFile.mainTree, name);
end
else
begin
Expand Down Expand Up @@ -882,11 +903,13 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
uniqueStrings(result);
end;

procedure setAttr(a:TfileAttribute; parName:string);
procedure setAttr(a: TfileAttribute; const parName: String);
var
v: String;
begin
if parExist(parname) then
if parExistVal(parname, v) then
try
if isTrue(parEx(parname)) then
if isTrue(v) then
include(f.flags, a)
else
exclude(f.flags, a);
Expand All @@ -903,7 +926,7 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
f.setDynamicComment(LP, macroDequote(parEx('comment')))
except end;
try
f.name:=parEx('name');
f.name := parEx('name');
if assigned(f.node) then
f.node.text:=f.name;
except end;
Expand Down Expand Up @@ -1292,10 +1315,9 @@ function cbMacros(fs: TFileServer; const fullMacro: String; pars: TPars; cbData:
i: integer;
v: string;
begin
if parExist('var') then
if parExistVal('var', v) then
try
v := parEx('var');
result:=getVar(v);
result := getVar(v);
except
result := pars[pars.count-1]
end
Expand Down Expand Up @@ -1349,8 +1371,8 @@ t_s2c = record s: String; val: byte; end;
if not icon and buttons then
inc(code, MB_ICONQUESTION);
case msgDlg(p, code, par(2)) of
MRYES, MROK: result:=if_(buttons, '1'); // if only OK button is available, then return nothing
MRCANCEL: result:=if_(code and MB_YESNOCANCEL = MB_YESNOCANCEL, 'cancel'); // for the YESNOCANCEL, we return cancel to allow to tell NO from CANCEL
MRYES, MROK: result := if_(buttons, '1'); // if only OK button is available, then return nothing
MRCANCEL: result := if_(code and MB_YESNOCANCEL = MB_YESNOCANCEL, 'cancel'); // for the YESNOCANCEL, we return cancel to allow to tell NO from CANCEL
else result:='';
end;
end; // dialog
Expand Down Expand Up @@ -1658,8 +1680,9 @@ t_s2c = record s: String; val: byte; end;
end; // getPairs

begin
if not satisfied(md.cd) then exit;
result:='';
if not satisfied(md.cd) then
exit;
result:='';
if parExist('value') then
try md.cd.conn.setCookie(p, parEx('value'), getPairs());
except result:=noMacrosAllowed(md.cd.conn.getCookie(p)) end // there was no "value" to set, so just read
Expand Down Expand Up @@ -1699,11 +1722,12 @@ t_s2c = record s: String; val: byte; end;
setVar(parEx('sub'), s);
except end;

try
result:=reReplace(subj, p, parEx('replace'), mods);
setVar(parEx('var'), result); // we put the output where we got the input
result:='';
except end;
try
result:=reReplace(subj, p, parEx('replace'), mods);
setVar(parEx('var'), result); // we put the output where we got the input
result:='';
except
end;
end; // regexp

procedure dir();
Expand Down Expand Up @@ -1926,7 +1950,7 @@ t_s2c = record s: String; val: byte; end;
end; // handleSymbol


function stringTotrayMessageType(s:string): TBalloonIconType;
function stringTotrayMessageType(const s: String): TBalloonIconType;
begin
if compareText(s,'warning') = 0 then
result:= bitWarning
Expand All @@ -1938,18 +1962,18 @@ t_s2c = record s: String; val: byte; end;
result:= bitNone
end; // stringTotrayMessageType

function renameIt(src,dst:string):boolean;
function renameIt(const src, dst: String): Boolean;
var
srcReal, dstReal: string;
begin
srcReal:=uri2diskMaybe(src,NIL,FALSE);
dstReal:=uri2diskMaybeFolder(dst);
if isExtension(srcReal, '.lnk')
and not isExtension(src, '.lnk') then
dstReal:=dstReal+'.lnk';
if extractFilePath(dstReal)='' then
dstReal:=extractFilePath(srcReal)+dstReal;
result:=renameFile(srcReal, dstReal)
srcReal:=uri2diskMaybe(src,NIL,FALSE);
dstReal:=uri2diskMaybeFolder(dst);
if isExtension(srcReal, '.lnk')
and not isExtension(src, '.lnk') then
dstReal:=dstReal+'.lnk';
if extractFilePath(dstReal)='' then
dstReal:=extractFilePath(srcReal)+dstReal;
result := renameFile(srcReal, dstReal)
end; // renameIt

var
Expand Down
59 changes: 50 additions & 9 deletions srv/IconsLib.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,6 +49,7 @@ TIconsDM = class(TDataModule)
{$ELSE ~FMX}
systemimages: Timagelist; // system icons
{$ENDIF FMX}
function GetBitmap(idx: Integer; Size: Integer): TBitmap;
function getImageIndexForFile(fn: string): integer;
end;

Expand All @@ -73,6 +74,7 @@ TIconsDM = class(TDataModule)
function str2pic(const s: RawByteString; imgSize: Integer): integer;
function strGif2pic(const gs: RawByteString; imgSize: Integer): integer;
function ico2str(hndl: THandle; icoNdx: Integer; imgSize: Integer): RawByteString;
function ico2bmp(hndl: THandle; icoNdx: Integer; imgSize: Integer): TBitmap;

function stringPNG2BMP(const s: RawByteString): TBitmap;

Expand Down Expand Up @@ -130,9 +132,11 @@ function getSystemimages(): TImageList;
result := TImageList.Create(NIL);
{$ELSE ~FMX}
result := Timagelist.Create(NIL);
Result.ColorDepth := cd32Bit;
result.ShareImages := TRUE;
{$IFNDEF FPC}
Result.ColorDepth := cd32Bit;
result.handle := hs;
{$ENDIF FPC}
{$ENDIF FMX}
end; // loadSystemimages

Expand Down Expand Up @@ -332,8 +336,8 @@ function gif2png(const s: RawByteString): RawByteString;
begin
Result := '';
ss := TRawByteStringStream.create(s);
bmp := TBitmap.Create;
try
bmp := TBitmap.Create;
{$IFDEF FMX}
bmp.loadFromStream(ss);
{$ELSE FMX}
Expand All @@ -344,6 +348,7 @@ function gif2png(const s: RawByteString): RawByteString;
Result := bmp2str(bmp);
finally
ss.free;
bmp.Free;
{$IFNDEF FMX}
gif.Free;
{$ENDIF ~FMX}
Expand Down Expand Up @@ -376,7 +381,7 @@ function bmp2str(bmp: Tbitmap): RawByteString;
PRGBAArray = ^TRGBAArray;
{$IFNDEF FMX}
var
png: TPNGImage;
png: TPNGImage;
RowInOut: PRGBAArray;
RowAlpha: PByteArray;
{$ENDIF FMX}
Expand All @@ -387,6 +392,9 @@ function bmp2str(bmp: Tbitmap): RawByteString;
png := TPNGImage.Create();
try
// png.ColorReduction:=rmQuantize;
{$IFDEF FPC}
png.LoadFromBitmapHandles(bmp.Handle, bmp.MaskHandle);
{$ELSE ~FPC}
png.Assign(bmp);
{$IFDEF FMX}
if bmp.PixelFormat in [TPixelFormat.RGBA, TPixelFormat.BGRA, TPixelFormat.RGBA16] then
Expand All @@ -403,6 +411,7 @@ function bmp2str(bmp: Tbitmap): RawByteString;
RowAlpha[X] := RowInOut[X].rgbReserved;
end;
end;
{$ENDIF ~FPC}
result := png2str(png);
finally png.free;
end;
Expand Down Expand Up @@ -433,11 +442,7 @@ function pic2str(idx: integer; imgSize: Integer): RawByteString;

bmp := nil;
try
{$IFDEF FMX}
bmp := IconsDM.Images.Bitmap(TSizeF.Create(imgSize, imgSize), idx);
{$ELSE FMX}
bmp := IconsDM.ImgCollection.GetBitmap(idx, imgSize, imgSize);
{$ENDIF FMX}
bmp := IconsDM.GetBitmap(idx, imgSize);

if Assigned(bmp) then
begin
Expand Down Expand Up @@ -471,6 +476,22 @@ function ico2str(hndl: THandle; icoNdx: Integer; imgSize: Integer): RawByteStrin
end;
end;

function ico2bmp(hndl: THandle; icoNdx: Integer; imgSize: Integer): TBitmap;
//var
//bmp: TBitmap;
begin
Result := TBitmap.Create;
try
Result.PixelFormat := pf32bit;
Result.SetSize(imgSize, imgSize);
{$IFDEF FPC} Result.BeginUpdate(True); {$ENDIF FPC}
ImageList_DrawEx(hndl, icoNdx, Result.Canvas.Handle, 0, 0, imgSize, ImgSize, CLR_NONE, CLR_NONE, ILD_SCALE or ILD_PRESERVEALPHA);
{$IFDEF FPC} Result.EndUpdate; {$ENDIF FPC}
finally
//bmp.Free;
end;
end;

function str2pic(const s: RawByteString; imgSize: Integer): Integer;
var
{$IFDEF FMX}
Expand Down Expand Up @@ -559,6 +580,25 @@ function stringPNG2BMP(const s: RawByteString): TBitmap;
{$ENDIF FMX}
end;

function TIconsDM.GetBitmap(idx: Integer; Size: Integer): TBitmap;
begin
{$IFDEF FMX}
result := Images.Bitmap(TSizeF.Create(Size, Size), idx);
{$ELSE FMX}
{$IFDEF FPC}
Result := NIL;
if Self.images.Count > idx then
begin
Result := TBitmap.Create;
Result.SetSize(Size, Size);
Self.images.GetBitmap(idx, Result);
end;
{$ELSE ~FPC}
Result:= imgCollection.GetBitmap(idx, size, size);
{$ENDIF FPC}
{$ENDIF FMX}
end;

function TIconsDM.getImageIndexForFile(fn: String): Integer;
var
newIdx, n: integer;
Expand Down Expand Up @@ -588,7 +628,8 @@ function TIconsDM.getImageIndexForFile(fn: String): Integer;
{$IFNDEF FMX}

// have we already met this sysidx before?
for var i:=0 to length(sysidx2index)-1 do
if length(sysidx2index) > 0 then
for var i:=0 to length(sysidx2index)-1 do
if sysidx2index[i].sysidx = shfi.iIcon then
begin
result := sysidx2index[i].idx;
Expand Down
Loading

0 comments on commit b699f9a

Please sign in to comment.