stub.dpr

PEZIP捆绑壳delphi源代码 一份不错的源码

program PEZipStub;

uses
  Windows, Unpack, CRC32, TLHelp32;

const
  Flag: DWORD = $2E444E45;

type
  TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);

  LongRec = packed record
    Lo, Hi: Word;
  end;

  TSysLocale = packed record
    DefaultLCID: LCID;
    PriLangID: LANGID;
    SubLangID: LANGID;
    FarEast: Boolean;
    MiddleEast: Boolean;
  end;

var
  LeadBytes: set of Char = [];
  SysLocale: TSysLocale;

var
  pCBuff: Pointer;
  pDBuff: Pointer;
  hFile: Cardinal;
  OFS: TOFStruct;
  OrigSize: Cardinal;
  CompSize: Cardinal;
  AFlag: DWORD;
  bRead: Cardinal;
  tmpFile, tmpExe: string;
  zCRC32, zCRC32A: Cardinal;

const
  BackOffset = SizeOf(OrigSize) + SizeOf(CompSize) + SizeOf(Flag) + SizeOf(zCRC32);

function FileAge(const FileName: string): Integer;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
begin
  Handle:= FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
        LongRec(Result).Lo) then Exit;
    end;
  end;
  Result:= -1;
end;

function FileExists(const FileName: string): Boolean;
begin
  Result:= FileAge(FileName) <> -1;
end;

procedure ProcessMessages;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, GetCurrentProcess, 0, 0, PM_REMOVE) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;

function StrScan(const Str: PChar; Chr: Char): PChar; assembler;
asm
        PUSH    EDI
        PUSH    EAX
        MOV     EDI,Str
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        NOT     ECX
        POP     EDI
        MOV     AL,Chr
        REPNE   SCASB
        MOV     EAX,0
        JNE     @@1
        MOV     EAX,EDI
        DEC     EAX
  @@1:  POP     EDI
end;

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
var
  I: Integer;
begin
  Result := mbSingleByte;
  if (P = nil) or (P[Index] = #$0) then Exit;
  if (Index = 0) then
  begin
    if P[0] in LeadBytes then Result := mbLeadByte;
  end
  else
  begin
    I := Index - 1;
    while (I >= 0) and (P[I] in LeadBytes) do Dec(I);
    if ((Index - I) mod 2) = 0 then Result := mbTrailByte
    else if P[Index] in LeadBytes then Result := mbLeadByte;
  end;
end;

function ByteType(const S: string; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if SysLocale.FarEast then
    Result := ByteTypeTest(PChar(S), Index-1);
end;

function LastDelimiter(const Delimiters, S: string): Integer;
var
  P: PChar;
begin
  Result:= Length(S);
  P:= PChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
      if (ByteType(S, Result) = mbTrailByte) then
        Dec(Result)
      else
        Exit;
    Dec(Result);
  end;
end;

function ExtractFilePath(const FileName: string): string;
var
  I: Integer;
begin
  I:= LastDelimiter('\:', FileName);
  Result:= Copy(FileName, 1, I);
end;

function ExtractFileName(const FileName: string): string;
var
  I: Integer;
begin
  I:= LastDelimiter('\:', FileName);
  Result:= Copy(FileName, I + 1, MaxInt);
end;

function GetCMDLine: string;
var
  I: Integer;
  S: string;
begin
  for I:= 1 to ParamCount do
    S:= S + ParamStr(I) + #32;
  Result:= S;
end;

procedure Execute(const FileName: string);
var
  lpStartupInfo: TStartupInfo;
  lpProcessInformation: TProcessInformation;
begin
  FillChar(lpStartupInfo, SizeOf(lpStartupInfo), 0);
  lpStartupInfo.cb:= SizeOf(lpStartupInfo);
  CreateProcess(PChar(FileName), PChar(GetCMDLine), nil, nil, true,
    CREATE_DEFAULT_ERROR_MODE, nil, PChar(ExtractFilePath(ParamStr(0))),
    lpStartupInfo, lpProcessInformation);
end;

procedure ShowError(const ErrorMsg: string);
begin
  MessageBox(0, PChar(ErrorMsg), 'Error', MB_ICONWARNING);
end;

function UpperCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L:= Length(S);
  SetLength(Result, L);
  Source:= Pointer(S);
  Dest:= Pointer(Result);
  while L <> 0 do
  begin
    Ch:= Source^;
    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
    Dest^:= Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function AppActived(const ExeFileName: string): Boolean;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result:= False;
  FSnapshotHandle:= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize:= SizeOf(FProcessEntry32);
  ContinueLoop:= Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
    if UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName) then
    begin
      Result:= True;
      Break;
    end;
    ContinueLoop:= Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

function GetTempFile: string;
var
  Buff: array[0..MAX_PATH] of Char;
begin
  FillChar(Buff, SizeOf(Buff), #0);
  if GetTempFileName(PChar(ExtractFilePath(ParamStr(0))), 'pzp', 0, Buff) = 0 then
  begin
    FillChar(Buff, SizeOf(Buff), #0);
    GetTempPath(SizeOf(Buff), Buff);
    GetTempFileName(Buff, 'pzp', 0, Buff);
  end;
  Result:= Buff;
end;

begin
  SetErrorMode(SEM_FAILCRITICALERRORS);
  try
    hFile:= OpenFile(PChar(ParamStr(0)), OFS, OF_READ or OF_SHARE_DENY_READ);
    if hFile = INVALID_HANDLE_VALUE then Exit;
    SetFilePointer(hFile, -BackOffset, nil, FILE_END);
    ReadFile(hFile, AFlag, SizeOf(AFlag), bRead, nil);
    if AFlag <> Flag then
    begin
      ShowError('Invalid file checksum');
      Exit;
    end;
    ReadFile(hFile, OrigSize, SizeOf(OrigSize), bRead, nil);
    ReadFile(hFile, CompSize, SizeOf(CompSize), bRead, nil);
    ReadFile(hFile, zCRC32, SizeOf(zCRC32), bRead, nil);
    if (OrigSize = 0) or (CompSize = 0) then
    begin
      ShowError('Invalid file checksum');
      Exit;
    end;
    SetFilePointer(hFile, -(BackOffset + CompSize), nil, FILE_END);
    GetMem(pCBuff, CompSize);
    GetMem(pDBuff, OrigSize);
    ReadFile(hFile, pCBuff^, CompSize, bRead, nil);
    CloseHandle(hFile);                                    
    DecompressBuff(pCBuff, CompSize, pDBuff, OrigSize);
    if pCBuff <> nil then FreeMem(pCBuff);
    zCRC32A:= 0;
    CRC32Full(pDBuff, OrigSize, zCRC32A);
    if zCRC32 <> zCRC32A then
    begin
      if pDBuff <> nil then FreeMem(pDBuff);
      ShowError('Invalid file checksum');
      Exit;
    end;
    tmpFile:= GetTempFile;
    if not FileExists(tmpFile) then Exit;
    SetFileAttributes(PChar(tmpFile), 0);
    hFile:= OpenFile(PChar(tmpFile), OFS, OF_WRITE or OF_SHARE_DENY_NONE);
    WriteFile(hFile, pDBuff^, OrigSize, bRead, nil);
    CloseHandle(hFile);
    SetFileAttributes(PChar(tmpFile), FILE_ATTRIBUTE_HIDDEN);
    if pDBuff <> nil then FreeMem(pDBuff);
    Execute(tmpFile);
    tmpExe:= ExtractFileName(tmpFile);
    while AppActived(tmpExe) do
    begin
      Sleep(100);
      ProcessMessages;
    end;
    SetFileAttributes(PChar(tmpFile), 0);
    DeleteFile(PChar(tmpFile));
  except
    FatalExit(GetLastError);
  end;
end.