Solved

FtpPutFile api Function

Posted on 2001-06-30
2
1,303 Views
Last Modified: 2010-05-18
Please can someone show me how to use the FtpPutFile api Function.

Here is the doc on it: http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/reference/functions/FtpPutFile.asp


I've tried the following but it fails.
FtpPutFile(nil, 'D:\localfile.htm, 'ftp://username:pass@ftp.domain/remotefile.htm', 0, 0);

Cheer Ian
0
Comment
Question by:campid
2 Comments
 
LVL 2

Accepted Solution

by:
bugroger earned 25 total points
Comment Utility
Hi,

I think your function fails because your FTP handle
is NIL.
Look at this code which I have found at:
 http://homepages.borland.com/ccalvert/TechPapers/Delphi/Internet.html
 
unit Ftp1;

{ FTP example using WININET.PAS rather than
  an ACTIVEX control. Requires WININET.PAS and
  WININET.DLL. WININET.DLL you can get from
  Microsoft, WININET.PAS is available from
  www.borland.com, or with some versions of
  Delphi 2.0.
 
  You might Respond to OnNewDir events as follows:

  procedure TForm1.FTP1NewDir(Sender: TObject);
  begin
    ListBox1.Items := MyFtp1.FindFiles; // Get the directory list
  end;  
}

interface

uses
  Windows, Classes, WinINet,
  SysUtils;
 
type
  TMyFtp = class(TComponent)
  private
    FContext: Integer;
    FINet: HInternet;
    FFtpHandle: HInternet;
    FCurFiles: TStringList;
    FServer: string;
    FOnNewDir: TNotifyEvent;
    FCurDir: string;
    FUserID: string;
    FPassword: string;
    function GetCurrentDirectory: string;
    procedure SetUpNewDir;
  protected
    destructor Destroy; override;
  public
    constructor Create(AOwner: TComponent); override;
    function Connect: Boolean;
    function FindFiles: TStringList;
    function ChangeDirExact(S: string): Boolean;
    function ChangeDirCustom(S: string): Boolean;
    function BackOneDir: Boolean;
    function GetFile(FTPFile, NewFile: string): Boolean;
    function SendFile1(FTPFile, NewFile: string): Boolean;
    function SendFile2(FTPFile, NewFile: string): Boolean;
    function CustomToFileName(S: string): string;
  published
    property CurFiles: TStringList read FCurFiles;
    property CurDir: string read FCurDir;
    property UserID: string read FUserID write FUserID;
    property Password: string read FPassword write FPassword;
    property Server: string read FServer write FServer;
    property OnNewDir: TNotifyEvent read FOnNewDir
                write FOnNewDir;
  end;

procedure Register;

implementation

uses
  Dialogs;

// A few utility functions

function GetFirstToken(S: string; Token: Char): string;
var
  Temp: string;
  Index: INteger;
begin
  Index := Pos(Token, S);
  if Index < 1 then begin
    GetFirstToken := '';
    Exit;
  end;
  Dec(Index);
  SetLength(Temp, Index);
  Move(S[1], Temp[1], Index);
  GetFirstToken := Temp;
end;

function StripFirstToken(S: string; Ch: Char): string;
var
  i, Size: Integer;
begin
  i := Pos(Ch, S);
  if i = 0 then begin
    StripFirstToken := S;
    Exit;
  end;
  Size := (Length(S) - i);
  Move(S[i + 1], S[1], Size);
  SetLength(S, Size);
  StripFirstToken := S;
end;

function ReverseStr(S: string): string;
var
  Len: Integer;
  Temp: String;
  i,j: Integer;
begin
  Len := Length(S);
  SetLength(Temp, Len);
  j := Len;
  for i := 1 to Len do begin
    Temp[i] := S[j];
    dec(j);
  end;
  ReverseStr := Temp;
end;

function StripLastToken(S: string; Token: Char): string;
var
  Temp: string;
  Index: INteger;
begin
  SetLength(Temp, Length(S));
  S := ReverseStr(S);
  Index := Pos(Token, S);
  Inc(Index);
  Move(S[Index], Temp[1], Length(S) - (Index - 1));
  SetLength(Temp, Length(S) - (Index - 1));
  StripLastToken := ReverseStr(Temp);
end;


procedure Register;
begin
  RegisterComponents('Unleash', [TMyFtp]);
end;

constructor TMyFtp.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCurFiles := TStringList.Create;
  FINet := InternetOpen('WinINet1', 0, nil, 0, 0);
end;

destructor TMyFtp.Destroy;
begin
  if FINet <> nil then
    InternetCloseHandle(FINet);
  if FFtpHandle <> nil then
    InternetCloseHandle(FFtpHandle);
  inherited Destroy;
end;

function TMyFtp.Connect: Boolean;
begin
  FContext := 255;
  FftpHandle := InternetConnect(FINet, PChar(FServer), 0,
   PChar(FUserID), PChar(FPassWord),
   Internet_Service_Ftp, 0, FContext);
  if FFtpHandle = nil then
    Result := False
  else begin
    SetUpNewDir;
    Result := True;
  end;
end;

function TMyFtp.GetCurrentDirectory: string;
var
  Len: Integer;
  S: string;
begin
  Len := 0;
  ftpGetCurrentDirectory(FFTPHandle, PChar(S), Len);
  SetLength(S, Len);
  ftpGetCurrentDirectory(FFTPHandle, PChar(S), Len);
  Result := S;
end;

procedure TMyFtp.SetUpNewDir;
begin
  FCurDir := GetCurrentDirectory;
  if Assigned(FOnNewDir) then
    FOnNewDir(Self);            
end;

function GetDots(NumDots: Integer): string;
var
  S: string;
  i: Integer;
begin
  S := '';
  for i := 1 to NumDots do
    S := S + ' ';
  Result := S;
end;

function GetFindDataStr(FindData: TWin32FindData): string;
var
  S: string;
  Temp: string;
begin
  case FindData.dwFileAttributes of
    FILE_ATTRIBUTE_ARCHIVE: S := 'A';
//    FILE_ATTRIBUTE_COMPRESSED: S := 'C';
    FILE_ATTRIBUTE_DIRECTORY: S := 'D';
    FILE_ATTRIBUTE_HIDDEN: S := 'H';
    FILE_ATTRIBUTE_NORMAL: S := 'N';
    FILE_ATTRIBUTE_READONLY: S := 'R';
    FILE_ATTRIBUTE_SYSTEM: S := 'S';
    FILE_ATTRIBUTE_TEMPORARY: S := 'T';
  else
    S := IntToStr(FindData.dwFileAttributes);
  end;
  S := S + GetDots(75);
  Move(FindData.CFilename[0], S[6], StrLen(FindData.CFileName));
  Temp := IntToStr(FindData.nFileSizeLow);
  Move(Temp[1], S[25], Length(Temp));
  Result := S;
end;

function TMyFtp.FindFiles: TStringList;
var
  FindData: TWin32FindData;
  FindHandle: HInternet;
begin
   FindHandle := FtpFindFirstFile(FFtphandle, '*.*',
     FindData, 0, 0);
   if FindHandle = nil then begin
     Result := nil;
     Exit;
   end;
   FCurFiles.Clear;
   FCurFiles.Add(GetFindDataStr(FindData));
   while InternetFindnextFile(FindHandle, @FindData) do
     FCurFiles.Add(GetFindDataStr(FindData));
   InternetCloseHandle(Findhandle);
   GetCurrentDirectory;
   Result := FCurFiles;
end;

function TMyFtp.CustomToFileName(S: string): string;
const
  PreSize = 6;
var
  Temp: string;
  TempSize: Integer;
begin
  Temp := '';
  TempSize := Length(S) - PreSize;
  SetLength(Temp, TempSize);
  Move(S[PreSize], Temp[1], TempSize);
  Temp := GetFirstToken(Temp, ' ');
  Result := Temp;
end;

function TMyFtp.BackOneDir: Boolean;
var
  S: string;
begin
  S := FCurDir;
  S := StripLastToken(S, '/');
  if S = '/' then begin
    Result := False;
    Exit;
  end;

  if S <> '' then begin
    ChangeDirExact(S);
    Result := True;
  end else begin
    ChangeDirExact('/');
    Result := True;
  end;

end;

// Changes to specific directory in S
function TMyFtp.ChangeDirExact(S: string): Boolean;
begin
  if S <> '' then
    FtpSetCurrentDirectory(FFTPHandle, PChar(S));
  Result := True;
  FindFiles;
  SetUpNewDir;
end;

// Assumes S has been returned by GetFindDataString;
function TMyFtp.ChangeDirCustom(S: string): Boolean;
begin
  S := CustomToFileName(S);
  if S <> '' then
    FtpSetCurrentDirectory(FFTPHandle, PChar(S));
  Result := True;
  FindFiles;
  SetUpNewDir;
end;

function TMyFtp.GetFile(FTPFile, NewFile: string): Boolean;
begin
  Result := FtpGetFile(FFTPHandle, PChar(FTPFile), PChar(NewFile),
               False, File_Attribute_Normal,
               Ftp_Transfer_Type_Binary, 0);
end;

function TMyFtp.SendFile1(FTPFile, NewFile: string): Boolean;
const
  Size:DWord = 3000;
var
  Transfer: Bool;
  Error: DWord;
  S: string;
begin
  Transfer := FtpPutFile(FFTPHandle, PChar(FTPFile),
                         PChar(NewFile),
                         Ftp_Transfer_Type_Binary, 0);

  if not Transfer then begin
    Error := GetLastError;
    ShowMessage(Format('Error Number: %d. Hex: %x',
                       [Error, Error]));
    SetLength(S, Size);
    if not InternetGetLastResponseInfo(Error, PChar(S), Size) then
    begin
      Error := GetLastError;
      ShowMessage(Format('Error Number: %d. Hex: %x',
        [Error, Error]));
    end;
    ShowMessage(Format('Error Number: %d. Hex: %x Info: %s',
                       [Error, Error, S]));
  end else
    ShowMessage('Success');
  Result := Transfer;
end;

function TMyFtp.SendFile2(FTPFile, NewFile: string): Boolean;
var
  FHandle: HInternet;
begin
  FHandle :=  FtpOpenFile(FFTPHandle, 'sam.txt', GENERIC_READ,
                           FTP_TRANSFER_TYPE_BINARY, 0);
  if FHandle <> nil then
  InternetCloseHandle(FHandle)
  else
    ShowMessage('Failed');
  Result := True;
end;

end.  

GL
bug


0
 

Author Comment

by:campid
Comment Utility
cheers for that, looks like i need to connect to the server before issuing that command.

The http one i was using did everything in one, which was why I thought this would..

cheers

ian

oh do you know of any good delphi api resources or where to get hold of the uncompiled delphi include files so I only have to compiled versions.
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now