fpset.pas

你用过ExeScope吗？它是能够将Exe文件中的资源进行查看并修改的工具

    $041c:  result := 'Albanian';
    $041d:  result := 'Swedish';
    $081d:  result := 'Swedish (Finland)';
    $041e:  result := 'Thai';
    $041f:  result := 'Turkish';
    $0421:  result := 'Indonesian';
    $0422:  result := 'Ukrainian';
    $0423:  result := 'Belarusian';
    $0424:  result := 'Slovenian';
    $0425:  result := 'Estonian';
    $0426:  result := 'Latvian';
    $0427:  result := 'Lithuanian';
    $081a:  result := 'Serbian';
    $0429:  result := 'Farsi';
    $042d:  result := 'Basque';
    $0436:  result := 'Afrikaans';
    $0438:  result := 'Faeroese';

    $FFFF:  result := '系统默认语言';
    else result:=Format('$%.4x',[w]);
  end;
end;

 { 取得所用的字符集 }
function TransCodePage(w:WORD):String;
begin
  case w of
    $0000:  result := '7 bit ASCII';
    $03A4:  result := 'Windows,Japan';
    $03B5:  result := 'Windows,Korea';
    $03B6:  result := 'Windows,Taiwan';
    $04B0:  result := 'UniCode';
    $04E2:  result := 'Windows,Latin-2';
    $04E3:  result := 'Windows,Cyrillic';
    $04E4:  result := 'Windows,MultiLingual';
    $04E5:  result := 'Windows,Greek';
    $04E6:  result := 'Windows,Turkish';
    $04E7:  result := 'Windows,Hebreal';
    $04E8:  result := 'Windows,Arabic';
    $FFFF:  result := '系统默认';
    else result:=Format('$%.4x',[w]);
  end;
end;

 { 程序自我删除,可用于卸载 }
procedure DeleteMySelf(handle: THandle);
var
  hModule: THandle;
  buff:  array[0..MAX_PATH] of char;
  hKernel32:Thandle;
  pExitProcess,pDeleteFileA,pUnmapViewOfFile:Pointer;
begin
  hModule := GetModuleHandle(nil);
  GetModuleFileName(handle,buff,sizeof(buff));
  CloseHandle(THandle(4));
  hKernel32 := GetModuleHandle('KERNEL32');
  pExitProcess := GetProcAddress(hKernel32,'ExitProcess');
  pDeleteFileA := GetProcAddress(hKernel32,'DeleteFileA');
  pUnmapViewOfFile := GetProcAddress(hKernel32,'UnmapViewOfFile');
  asm
    lea  eax,bufF
    push 0
    push 0
    push eax
    push pExitProcess
    push hModule
    push pDeleteFileA
    push pUnmapViewOfFile;
    ret
  end;
end;

{ 获得Windows操作系统的版本 }
function GetWinVersion: String;
var
  VersionInfo : TOSVersionInfo;
  OSName      : String;
begin
  // set the size of the record
  VersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

  if Windows.GetVersionEx(VersionInfo) then
  with VersionInfo do
  begin
     case dwPlatformId of
        VER_PLATFORM_WIN32s        : OSName := 'Win32s';
        VER_PLATFORM_WIN32_WINDOWS : OSName := 'Windows 95';
        VER_PLATFORM_WIN32_NT      : OSName := 'Windows NT';
     end; // case dwPlatformId
     if dwMajorVersion > 4 then OSName := 'Windows 2000';
     Result := Format('%s  [ 版本号：%d.%d.%d ]'+#13+#10+'%s',[OSName,dwMajorVersion,dwMinorVersion,dwBuildNumber,szCSDVersion]);
  end // if GetVersionEx
  else
     Result := '';
end;

 { 关机 }
procedure ShutDown;
const
    SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';   // Borland forgot this declaration
var
  hToken       : THandle;
  tkp          : TTokenPrivileges;
  tkpo         : TTokenPrivileges;
  zero         : DWORD;
  VersionInfo  : TOSVersionInfo;
begin
  VersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

  if Windows.GetVersionEx(VersionInfo) then
  begin
    if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
    begin
      zero := 0;
      if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
      begin
        MessageBox( 0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK );
        Exit;
      end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
      if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
      begin
        MessageBox( 0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK );
        Exit;
      end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)
      // SE_SHUTDOWN_NAME
      if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[ 0 ].Luid ) then
      begin
        MessageBox( 0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK );
        Exit;
      end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid )
      tkp.PrivilegeCount := 1;
      tkp.Privileges[ 0 ].Attributes := SE_PRIVILEGE_ENABLED;

      AdjustTokenPrivileges( hToken, False, tkp, SizeOf( TTokenPrivileges ), tkpo, zero );
      if Boolean( GetLastError() ) then
      begin
        MessageBox( 0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK );
        Exit;
      end // if Boolean( GetLastError() )
      else
        ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
    end
    else begin
      ExitWindowsEx( EWX_FORCE or EWX_SHUTDOWN, 0 );
    end;
  end;
end;

{ 比较两个DWORD是否相同 }
function IsSameDWORD(dw1,dw2:DWORD):Boolean;
begin
  if (dw1 and dw2) = dw2 then
    result := True
  else result := False;
end;

{ 版本文件标志 }
function  IsFileFlags(dw1,dw2:DWORD):Boolean;
begin
  if dw1=0 then
     result:=False
  else
     result:=IsSameDWORD(dw1,dw2);
end;

function IsSameWORD(w1,w2:WORD):Boolean;
begin
  if (w1 and w2) = w2 then
    result := True
  else result := False;

end;

function IsVirtField(w1,w2:WORD):Boolean;
begin
  if w1=0 then
     result:=False
  else
     result:=IsSameWORD(w1,w2);
end;

{********************************************************************
  以指定的压缩比率CompressionLevel压缩指定的内存流CompressedStream。
  首先将压缩前的流大小保存在最开始部分。
  //如果作为一个独立的单元要uses Classes,ZLib;
********************************************************************}
procedure PackStream(var CompressedStream: TMemoryStream; const CompressionLevel: TCompressionLevel);
var
  tmpCompressStream: TCompressionStream;
  tmpMemStream:  TMemoryStream;
  Count : Integer;
begin
  Count := CompressedStream.Size;
  tmpMemStream := TMemoryStream.Create;
  try
    //进行流的压缩
    tmpCompressStream := TCompressionStream.Create(CompressionLevel,tmpMemStream);
    try
      CompressedStream.SaveToStream(tmpCompressStream);
    finally
      tmpCompressStream.Free;
    end;
    //将压缩的流处理保存回流中
    CompressedStream.Clear;
    CompressedStream.WriteBuffer(Count,SizeOf(Count));
    CompressedStream.CopyFrom(tmpMemStream,0);
  finally
    tmpMemStream.Free;
  end;
end;

{********************************************************************
  将已被压缩的流ProcStream解压到ProcStream流中.
  此处首先读流的大小，所以必须与PackStream匹配使用.
********************************************************************}
procedure UnPackStream(var ProcStream: TMemoryStream);
var
  tmpMemStream: TMemoryStream;
  tmpDeCompressStream: TDeCompressionStream;
  Count: Integer;
  Buffer: PChar;
begin
  ProcStream.ReadBuffer(Count,SizeOf(Count));  //读出解压流后的大小。

  tmpMemStream := TMemoryStream.Create;
  try
    //解压到临时内存流tmpMemStream.
    tmpDeCompressStream := TDecompressionStream.Create(ProcStream);
    try
      GetMem(Buffer,Count);
      try
        tmpDeCompressStream.ReadBuffer(Buffer^,Count);
        tmpMemStream.WriteBuffer(Buffer^,Count);
      finally
        FreeMem(Buffer);
      end;
    finally
      tmpDeCompressStream.Free;
    end;
    //重新写到处理流ProcStream.
    ProcStream.SetSize(Count);
    ProcStream.LoadFromStream(tmpMemStream);
  finally
    tmpMemStream.Free;
  end;
end;

end.