{$D-,O+,Q-,R-,S-}
{
Main source File for WdxInfoPacker (build the dll)
Written by Franck Gartemann from 03/2005 to 01/2008
}
library WdxInfoPacker;
uses
interfaces,
SysUtils,
windows,
dialogs,
messages,
Classes,
WdxStruc in 'WdxStruc.pas',
wcxhead in 'wcxhead.pas',
MonDialogue in 'MonDialogue.pas',
FileProcessing in 'FileProcessing.pas',
Thread_IniPop in 'Thread_IniPop.pas',
RegExpr in 'RegExpr.pas',
someStuff in 'someStuff.pas',
AddSchemeComment in 'AddSchemeComment.pas' {Form1};
//{$E wcx}
{$R *.res}
var
DefaultPath:array[0..MAX_PATH]of char;
// PackerChangeVolProc:TChangeVolProc;
PackerProcessDataProc:TProcessDataProc;
FileProcess:TFileProcess;
function SetChangeVolProc(hArcData:THandle;ChangeVolProc1:TChangeVolProc):longint; stdcall;begin {PackerChangeVolProc:=ChangeVolProc1;} result:=0 ;end;
function SetProcessDataProc(hArcData:THandle;ProcessDataProc1:TProcessDataProc):longint; stdcall;begin
PackerProcessDataProc:=ProcessDataProc1;
result:=1;
end;
procedure PackSetDefaultParams(dps:pPackDefaultParamStruct); stdcall;
begin
FillChar(DefaultPath,sizeof(DefaultPath),#0);
strlcat(DefaultPath,dps^.DefaultIniName,sizeof(DefaultPath));
FileProcess:=TFileProcess.Create;
FileProcess.Init(DefaultPath);
FileProcess.ResetIniFile;
FileProcess.Free;
end;
{main Function--}
function PackFiles(PackedFile,SubPath,SrcPath,AddList:pchar;Flags:integer):integer; stdcall;
var
AllMyKnownWdx:array of TWdxInfo;
NomDuSchema:array[0..50] of char;
ExtensionAUtiliser:array[0..10] of char;
temp:string;
outputbuf:array[0..5*1024] of char;
pnextname,p:pchar;
RunOK,Add_Divider,AddCounter,AddText,ErrorFind,force:boolean;
CounterLength:cardinal;
plugCount:cardinal;
i,j,k:cardinal;
LeftCounter:cardinal;
nbOutPutLine:cardinal;
divider:string;
compar:string;
text2Add:string;
ContPlug:array[0..260] of char;
nbSep,locDiff,maxDiff:cardinal;
limitD:boolean;
SaveErrorLog:boolean;
FolderUse:boolean;
outPutStream,errorStream,workingStream:TMemoryStream;
sizeofStream:int64;
tlist:TStringList;
lenCh:pchar;
label skipThisElement,normalProcess;
begin
RunOK:=true;
lstrcpyn(ContPlug,pchar(ExtractFilePath(DefaultPath)+'contplug.ini'),sizeof(ContPlug));
FileProcess:=TFileProcess.Create;
plugCount:=FileProcess.Init(DefaultPath,runOK);
NomDuSchema[0]:=#0;
if not FileProcess.RunOrNot(PackedFile) then begin
MessageBox(GetActiveWindow,'You have to Configure the Plugin','Warning',MB_OK or MB_ICONEXCLAMATION);
end else begin
lstrcpyn(NomDuSchema,FileProcess.UtiliserScheme(PackedFile),Sizeof(NomDuSchema)); //send the name of the scheme to use
if StrLen(NomDuSchema)=0 then begin
MessageBox(GetActiveWindow,'You have to Configure the Plugin','Warning',MB_OK or MB_ICONEXCLAMATION);
result:=E_EABORTED;
exit
end;
FileProcess.loadSchemeOnce(NomDuSchema);
if not FileProcess.SchemeisEmpty then begin //If no info will be written -> abort the process
lstrcpyn(ExtensionAUtiliser,FileProcess.FileExtension,sizeof(ExtensionAUtiliser)); //To change the destination filename
if ExtensionAUtiliser <> '' then begin
temp:=StringReplace(PackedFile,ExtractFileExt(PackedFile), '.'+ExtensionAUtiliser,[rfReplaceAll, rfIgnoreCase]);
temp:=StringReplace(temp,'..\', '%A.\.\%A',[rfReplaceAll, rfIgnoreCase]);
temp:=StringReplace(temp,'..', '.',[rfReplaceAll, rfIgnoreCase]);
temp:=StringReplace(temp,'%A.\.\%A','..\',[rfReplaceAll, rfIgnoreCase]);
end else Temp:=PackedFile;
if FileExists(Temp) then begin
if idyes<>MessageBox(GetActiveWindow,'File exists, overwrite?',PackedFile,mb_yesnocancel or mb_iconquestion) then begin
result:=E_EABORTED;
exit
end;
end;
{
Init stuff : streams / plugin array / etc
}
outPutStream:=TMemoryStream.Create;
errorStream:=TMemoryStream.Create;
if plugCount>0 then begin
SetLength(AllMyknownWdx,plugCount); //we 'll load plugin only if we really process ...
plugCount:=FileProcess.LoadEachPlugin(AllMyKnownWdx);
// ShowMessage(AllMyKnownWdx[0].Name );
SetLength(AllMyKnownWdx,plugCount);
// ShowMessage(AllMyKnownWdx[0].Name );
end;
{
Begin the true process : header / body / footer
}
{header}
outPutStream.Seek(0,0);
lstrcpyn(outputbuf,FileProcess.WriteHeader(SrcPath,pchar(Temp)),sizeof(outputbuf));//'--WriteHeader'
if outputbuf<>'-1' then myStreamWrite(outputbuf,outPutStream,true);
Add_Divider:=FileProcess.UseDivider;//'--UseDivider between each part of line' it can be removed but functions prototype changed......
pnextname:=AddList; //1st element in the filelist
RunOK:=true;
k:=0;
limitD:=false;
nbSep:=0;
maxDiff:=0;
if FileProcess.limitDepth then begin
maxDiff:=FileProcess.GetRecursionDepth;
limitD:=true;
nbSep:=CountChar(SrcPath,'\')+1;
end;
SaveErrorLog:=FileProcess.SaveErrorLog;
FolderUse:=FileProcess.WorkWithFolder;
{body part : every element}
while (pnextname[0]<>#0) and RunOK do begin
ErrorFind:=false;
force:=false;
FillChar(outputbuf,sizeof(outputbuf),#0);
p:=strend(pnextname)-1;
if limitD then begin
// SrcPath+string(pnextname
lenCh:=StrAlloc(StrLen(SrcPath)+StrLen(pnextname));
StrCat(lenCh,SrcPath);
StrCat(lenCh,pnextname);
locDiff:=CountChar(LenCh,'\') - nbSep;
StrDispose(lenCh);
if locDiff>maxDiff then goto skipThisElement
else goto normalProcess;
end;
normalProcess:
if @PackerProcessDataProc<>nil then begin
if PackerProcessDataProc(pchar(string(SrcPath)+string(pnextname)),0)=0 then RunOK:=false;
end;
k:=k+1;
FileProcess.fileInfo.SubPath:=SubPath;
FileProcess.fileInfo.SrcPath:=SrcPath;
FileProcess.fileInfo.pnextname:=pnextname;
FileProcess.fileInfo.nbofplug:=plugCount;
FileProcess.fileInfo.currentFile:=k;
if p[0]<>'\' then //for files
strlcat(outputbuf,
FileProcess.ProcessOneFile( AllMyKnownWdx,
FileProcess.fileInfo,
Add_Divider,
ErrorFind,
force,
false
),
sizeof(outputbuf))
else if (FolderUse=true)then //for dir , when wanted only
strlcat(outputbuf,
FileProcess.ProcessOneFile( AllMyKnownWdx,
FileProcess.fileInfo,
Add_Divider,
ErrorFind,
force,
true
),
sizeof(outputbuf));
if not ErrorFind then myStreamWrite(outputbuf,outPutStream,true);//true means : all info wdx were empty
if SaveErrorLog and force then myStreamWrite(pnextname,errorStream,true);
skipThisElement: pnextname:=strend(pnextname)+1;
end;//end for one element
{footer}
FillChar(outputbuf,sizeof(outputbuf),#0);
strlcat(outputbuf,FileProcess.WriteFooter(SrcPath,pchar(Temp)),sizeof(outputbuf));//'--WriteFooter'
if outputbuf<>'-1' then myStreamWrite(outputbuf,outPutStream,false);
{
Freeing memory part :
* plugin array
* memory stream
}
FileProcess.FreePlugin(AllMyKnownWdx,plugCount);
Setlength(AllMyKnownWdx,0);
sizeofStream:=errorStream.Size;
//will save the error_log if it's not empty (>0 byte)
if ((SaveErrorLog=true) and (sizeofStream>0)) then begin
errorStream.Seek(0,0);
errorStream.SaveToFile(temp+'_ERROR.LOG');
end;
errorStream.Clear;
errorStream.Free;
{
post processing stuff : add counter and/or text
}
AddCounter:=FileProcess.AddCounter;
AddText:=FileProcess.AddTextAdditional;
if (AddCounter or AddText) then begin
outPutStream.Seek(0,0);
tlist:=TStringList.Create;
tlist.LoadFromStream(outPutStream);
nbOutPutLine:=tlist.Count-1;
if ((AddCounter=true)) then begin
CounterLength:=FileProcess.GetCounterLength;
LeftCounter:=FileProcess.GetCounterPos;
divider:=FileProcess.GetDivider;
for i:=0 to nbOutPutLine do begin
compar:='';
if ((CounterLength-length(inttostr(i)))>=1) then begin
for j:=1 to (CounterLength-length(inttostr(i))) do compar:=compar+'0';
end else compar:='';
if (divider<>'') then begin
if (LeftCounter=1) then tlist[i]:=compar+inttostr(i)+divider +tlist[i]; //write the new file on the right
if (LeftCounter=2) then tlist[i]:=tlist[i]+divider+compar+inttostr(i); //write the new file on the right
end else begin
if (LeftCounter=1) then tlist[i]:=compar+inttostr(i)+' '+tlist[i]; //write the new file on the right
if (LeftCounter=2) then tlist[i]:=tlist[i]+' '+compar+inttostr(i); //write the new file on the right
end;
end;
end;
if (AddText=true) then begin
text2Add:=FileProcess.GetAdditionalText;
LeftCounter:=FileProcess.GetIntervalText;
j:=0;
for i:=0 to nbOutPutLine do begin
if (j=LeftCounter) then begin
tlist[i]:=text2Add+tlist[i];
j:=0;
end;
j:=j+1;
end;
end;
workingStream:=TMemoryStream.Create;
tlist.SaveToStream(workingStream);
outPutStream.Clear;
workingStream.Seek(0,0);
outPutStream.LoadFromStream(workingStream);
workingStream.Clear;
workingStream.Free;
end;
sizeofStream:=outputStream.Size;
if sizeofStream>0 then begin
outPutStream.Seek(0,0);
outPutStream.SaveToFile(temp);
end;
outPutStream.Clear;
outPutStream.free;
end else begin
MessageBox(GetActiveWindow,'The scheme you want to use will not write any information to the destination file...','Operation Aborted',MB_OK or MB_ICONSTOP);
result:=E_EABORTED;
exit
end;
end;
result:=0;
end;
procedure ConfigurePacker(ParentHandle,DllInstance:thandle); stdcall;
var Dialogue:MonDial;
ContPlug:array[0..260]of char;
begin
lstrcpyn(ContPlug,pchar(ExtractFilePath(DefaultPath)+'contplug.ini'),sizeof(ContPlug));
Dialogue:=MonDial.Create;
Dialogue.CreerMonDialogue(ContPlug); //Open My Main form...
end;
//function CopyWdxInfoToClip(AddList,src,sub:pchar;NomDuSchema,DefPath,DestFile,myIni:pchar;finalStream:TMemoryStream):cardinal; stdcall;
function CopyWdxInfoToClip(AddList,NomDuSchema,DefPath,DestFile,myIni,src:pchar;finalStream:TMemoryStream):integer; stdcall;
var
outputbuf:array[0..5*1024] of char;
pnextname,p:pchar;
Add_Divider,AddCounter,AddText,ErrorFind,force:boolean;
CounterLength,i,j,k,LeftCounter,plugcount:integer;
divider,compar,text2Add:string;
ContPlug:array[0..260] of char;
AllMyKnownWdx:array of TWdxInfo;
nbSep,locDiff,maxDiff:integer;
limitD,folderUse:boolean;
tlist:TSTRINGLIST;
nbOutputline:cardinal;
sizeOfStream:int64;
outPutStream,workingStream:TMemoryStream;
LenCh:pchar;
label SkipThisElement,normalProcess;
begin
lstrcpyn(ContPlug,pchar(ExtractFilePath(DefaultPath)+'contplug.ini'),sizeof(ContPlug));
FileProcess:=TFileProcess.Create;
plugcount:=FileProcess.Init2(myIni,DefPath);
outPutStream:=TMemoryStream.Create;
outputbuf[0]:=#0;
pnextname:=AddList;
FileProcess.loadSchemeOnce(NomDuSchema);
if plugCount>0 then begin
SetLength(AllMyknownWdx,plugCount);
plugCount:=FileProcess.LoadEachPlugin(AllMyKnownWdx);
SetLength(AllMyknownWdx,plugCount);
end;
k:=0;
limitD:=false;
nbSep:=0;
maxDiff:=0;
if FileProcess.limitDepth then begin
maxDiff:=FileProcess.GetRecursionDepth;
limitD:=true;
nbSep:=CountChar(src,'\');
end;
folderUse:=FileProcess.WorkWithFolder;
{Header}
strlcat(outputbuf,FileProcess.WriteHeader((src),DestFile),sizeof(outputbuf));//'--WriteHeader'
if outputbuf<>'-1' then myStreamWrite(outputbuf,outPutStream,true);
Add_Divider:=FileProcess.UseDivider;
{body part : every file / folder}
while (pnextname[0]<>#0) do begin
//To Process the list of file
FillChar(outputbuf,sizeof(outputbuf),#0);
if ((pnextname[0]<>#0)) then begin
ExtractFileExt(pnextname);
ErrorFind:=false;
force:=false;
p:=strend(pnextname)-1;
if limitD then begin
lenCh:=StrAlloc(StrLen(src)+StrLen(pnextname));
StrCat(lenCh,src);
StrCat(lenCh,pnextname);
locDiff:=CountChar(LenCh,'\') - nbSep;
StrDispose(LenCh);
if locDiff>maxDiff then goto skipThisElement
else goto normalProcess;
end;
normalProcess:
k:=k+1;
FileProcess.fileInfo.SubPath:='';
FileProcess.fileInfo.SrcPath:=Src;
FileProcess.fileInfo.pnextname:=pnextname;
FileProcess.fileInfo.nbofplug:=plugCount;
FileProcess.fileInfo.currentFile:=k;
if p[0]<>'\' then //Only files
strlcat(outputbuf,
FileProcess.ProcessOneFile(AllMyKnownWdx,
FileProcess.fileInfo,
Add_Divider,
ErrorFind,
force,
false
),
sizeof(outputbuf))
else if (folderUse=true)then begin//folder when wanted
strlcat(outputbuf,
FileProcess.ProcessOneFile(AllMyKnownWdx,
FileProcess.fileInfo,
Add_Divider,
ErrorFind,
force,
true
),
sizeof(outputbuf)); end;
if ((not ErrorFind)) then myStreamWrite(outputbuf,outPutStream,true); //true means : all info wdx were empty
SkipThisElement:
pnextname:=strend(pnextname)+1;
end;
end;
FillChar(outputbuf,sizeof(outputbuf),#0);
strlcat(outputbuf,FileProcess.WriteFooter(src,pchar(DestFile)),sizeof(outputbuf));//'--WriteFooter'
if outputbuf<>'-1' then myStreamWrite(outputbuf,outPutStream,false);
FileProcess.FreePlugin(AllMyKnownWdx,plugcount);
SetLength(AllMyKnownWdx,0);
AddCounter:=FileProcess.AddCounter;
AddText:=FileProcess.AddTextAdditional;
if (AddCounter or AddText) then begin
outPutStream.Seek(0,0);
tlist:=TStringList.Create;
tlist.LoadFromStream(outPutStream);
nbOutPutLine:=tlist.Count-1;
if ((AddCounter=true)) then begin
CounterLength:=FileProcess.GetCounterLength;
LeftCounter:=FileProcess.GetCounterPos;
divider:=FileProcess.GetDivider;
for i:=0 to nbOutPutLine do begin
compar:='';
if ((CounterLength-length(inttostr(i)))>=1) then begin
for j:=1 to (CounterLength-length(inttostr(i))) do compar:=compar+'0';
end else compar:='';
if (divider<>'') then begin
if (LeftCounter=1) then tlist[i]:=compar+inttostr(i)+divider +tlist[i]; //write the new file on the right
if (LeftCounter=2) then tlist[i]:=tlist[i]+divider+compar+inttostr(i); //write the new file on the right
end else begin
if (LeftCounter=1) then tlist[i]:=compar+inttostr(i)+' '+tlist[i]; //write the new file on the right
if (LeftCounter=2) then tlist[i]:=tlist[i]+' '+compar+inttostr(i); //write the new file on the right
end;
end;
end;
if (AddText=true) then begin
text2Add:=FileProcess.GetAdditionalText;
LeftCounter:=FileProcess.GetIntervalText;
j:=0;
for i:=0 to nbOutPutLine do begin
if (j=LeftCounter) then begin
tlist[i]:=text2Add+tlist[i];
j:=0;
end;
j:=j+1;
end;
end;
workingStream:=TMemoryStream.Create;
tlist.SaveToStream(workingStream);
outPutStream.Clear;
workingStream.Seek(0,0);
outPutStream.LoadFromStream(workingStream);
workingStream.Clear;
workingStream.Free;
end;
sizeofStream:=outputStream.Size;
if sizeofStream>0 then begin
outPutStream.Seek(0,0);
finalStream.LoadFromStream(outPutStream);
end;
outPutStream.Clear;
outPutStream.free;
FileProcess.Free;
result:=sizeofStream;
end;
exports
OpenArchive,
CloseArchive,
ReadHeader,
ProcessFile,
SetChangeVolProc,
SetProcessDataProc,
PackFiles,
DeleteFiles,
PackSetDefaultParams,
GetPackerCaps,
ConfigurePacker,
CopyWdxInfoToClip
;
begin
end.
| Detected encoding: ASCII (7 bit) | 2
|