pascalfunctions.pas

可以使用硬件指纹作为密钥加密文件

unit PascalFunctions;
interface
uses Windows, Messages, SysUtils,Forms,Classes, Graphics,Dialogs,ExtCtrls, StdCtrls,commdlg,DBCtrls,ADODB,Db,ShlObj, ActiveX;

type
  TPascalFun = class(TObject)

  private
  public

    function MypChar(Word:AnsiString):PChar;
    function MyOrd(X:char):Integer;
    procedure WipeFile(FileName:string);
    function WinExecAndWait32(FileName:string; Visibility : integer):integer;
    function GetLongFileName(FileName:string):String;
    function GetSystemPath(): string;
    procedure CombineFile(ResName,ResType,target,source:String);
    Function ExportEncryptFile(FileName:String):String;
    procedure LoadFromRes(ResName,ResType,FileName:String);
    procedure SaveToPackage(ADOTable:TADOTable;save:TStream);
    procedure LoadFromPackage(ADOTable:TADOTable;load:TStream);
  end;


implementation

function TPascalFun.GetSystemPath(): string;
var
PIDL: PItemIDList;
Path: LPSTR;
AMalloc: IMalloc;
begin
Path := StrAlloc(MAX_PATH);
SHGetSpecialFolderLocation(hinstance, CSIDL_SENDTO , PIDL);
if SHGetPathFromIDList(PIDL, Path) then
Result := Path;
SHGetMalloc(AMalloc);
AMalloc.Free(PIDL);
StrDispose(Path);
end;

function TPascalFun.GetLongFileName(FileName:string):String;
var
srec :TSearchRec;
begin
Result:=ExtractFileDir(FileName);
if(Result<>FileName) then begin
if FindFirst(FileName,faAnyFile,srec)=0 then
try
Result:=GetLongFileName(Result)+'\'+srec.Name;
finally
FindClose(srec);
end
Else
raise Exception.CreateFmt('路径不存在！',[FileName]);
end
else
Delete(Result,Length(result),1);
end;
procedure TPascalFun.WipeFile(FileName:string);
var
buffer:array [0..4095] of Byte;
max,n:longint;
i:integer;
fs:TFileStream;
procedure RandomizeBuffer;
var
i:integer;
begin
for i:=Low(buffer) to High(buffer) do
buffer[i]:=Random(256);
end;
begin
if FileExists(FileName)=true then begin
fs:=TFilestream.Create(FileName,fmOpenReadWrite or fmShareExclusive);
try
for i:=1 to 3 do
begin
RandomizeBuffer;
max:=fs.size;
fs.position:=0;
while max =0 do
begin
 if max=SizeOf(buffer) then
 n:=SizeOf(buffer)
 else
 n:=max;
 fs.Write(Buffer,n);
 max:=max-n;
 end;
 FlushFileBuffers(fs.handle);
 end;
 finally
 fs.free;
 end;
 end;
 DeleteFile(FileName);
 end;

function TPascalFun.MyOrd(X:char):Integer;
begin
Result:=Ord(X);
end;

function TPascalFun.MypChar(Word:AnsiString):PChar;
begin
Result:=pChar(Word);
end;

procedure TPascalFun.LoadFromRes(ResName,ResType,FileName:String);
var Res:TResourceStream;
begin //先从资源中导出可执行文件
Res:=TResourceStream.Create(hinstance,ResName,pchar(ResType));
    Res.SaveToFile(FileName);
    Res.Free;
end;

procedure TPascalFun.SaveToPackage(ADOTable:TADOTable;save:TStream);
begin
TBlobField(ADOTable.FieldByName('FileStream')).LoadFromStream(save);
end;

procedure TPascalFun.LoadFromPackage(ADOTable:TADOTable;load:TStream);
begin
TBlobField(ADOTable.FieldByName('FileStream')).SaveToStream(load);
end;

function TPascalFun.WinExecAndWait32(FileName:string; Visibility : integer):integer;
 var
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
 begin
   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
   StartupInfo.cb := Sizeof(StartupInfo);
   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartupInfo.wShowWindow := Visibility;
   if not CreateProcess(nil,
     pchar(FileName),                      { pointer to command line string }
     nil,                           { pointer to process security attributes}
     nil,                           { pointer to thread security attributes }
     false,                         { handle inheritance flag }
     CREATE_NEW_CONSOLE or          { creation flags }
     NORMAL_PRIORITY_CLASS,
     nil,                           { pointer to new environment block }
     nil,                           { pointer to current directory name }
     StartupInfo,                   { pointer to STARTUPINFO }
     ProcessInfo) then Result := -1 { pointer to PROCESS_INF }
   else
      begin
      WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
      GetExitCodeProcess(ProcessInfo.hProcess,DWord(Result));
      end;
 end;

procedure TPascalFun.CombineFile(ResName,ResType,target,source:String) ;
var  //source为加密文件，target为欲生成的可执行文件的文件名
myfilesize:integer;
SourceFile,TargetExe:TFileStream;

begin //先从资源中导出可执行文件
LoadFromRes(ResName,Pchar(ResType),target);
   //把加密文件添加到早已编好的可执行文件的尾部
     SourceFile:=TFileStream.create(source,fmOpenReadWrite or fmshareexclusive);
     TargetExe:=tfilestream.create(target,fmopenwrite or fmshareexclusive);
     try
     TargetExe.seek(0,sofromend);//移动到尾部
     TargetExe.copyfrom(SourceFile,0);//从尾部复制文件
     myfilesize:=SourceFile.size+sizeof(myfilesize);//计算资源大小
     TargetExe.writebuffer(myfilesize,sizeof(myfilesize)); //写入辅程尾部
     finally
     TargetExe.free;
     SourceFile.free;
     WipeFile(Source);//合并后删除源文件
     end;
     end;

Function TPascalFun.ExportEncryptFile(FileName:String):String;
var  //从尾部读出加密文件  ,读出的文件名为XXXXXXXXXXXX.EXE.GV
source:TFileStream;
target:TMemoryStream;
myfilesize:integer;
begin
target:=TMemoryStream.create;
source:=TFileStream.create(FileName,fmopenread or fmsharedenynone);
try
source.seek(-sizeof(myfilesize),sofromend);
source.readbuffer(myfilesize,sizeof(myfilesize));//读出资源大小
source.seek(-myfilesize,sofromend);//定位到资源位置
target.copyfrom(source,myfilesize-sizeof(myfilesize));//取出资源
target.savetofile(System.Copy(FileName,0,Length(FileName)-4));//存放到文件
finally
target.free;
source.free;
result:=System.Copy(FileName,0,Length(FileName)-4);
end;
end;


end.