ftp_api.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

            begin
                item1.ImageIndex:=1;
                item1.SubItems.Strings[0]:='目录';//文件夹
                item1.SubItems.Strings[1]:= '0';
            end
            else
            begin
                item1.ImageIndex:=0;
                item1.SubItems.Strings[0]:='';//文件夹
                item1.SubItems.Strings[1]:= FileSizeToString(FileSize);
                item1.SubItems.Strings[2]:=
                GetFileTypeDescription(FRemotePath + FileName, True);
            end;
       end;
        R := InternetFindNextFile(Enum, @F);
    end;
    finally
        InternetCloseHandle(Enum);
        RemoteSort:=True;
    end;
end;
procedure TFTPMain.CollectSelectedItems(aListView:TListView;var aList:Tstringlist);
var
    Item: TListItem;
begin
    aList.Clear;
    Item := aListView.Selected;
    while Item <> nil do
    begin
        if (item.SubItems.Strings[0]<>'目录')
            and (item.caption<>'..') then
        begin
            alist.add(Item.Caption);
            Item := aListView.GetNextItem(Item, sdAll, [isSelected]);
        end;
    end;
end;

procedure TFTPMain.LocalUpdateListing;
var
    F: TWin32FindData;
    Enum: Hwnd;
    R: Bool;
    FileName: string;
    FileSize: Int64;
    Magic:integer;
    item1:TListItem;
begin
    Pointer(Enum) := nil;
    with Lview1 do
    try
    Clear;
    Update;
    Enum := FindFirstFile(PChar(FLocalPath + '*.*'), F);
    R := Pointer(Enum) <> nil;
    Magic:=0;
    while R do
    begin
        FileName := F.cFileName;
        if filename <>'.' then
        begin
            item1:=Lview1.Items.Add();
            item1.SubItems.Add('');
            item1.SubItems.Add('');
            item1.SubItems.Add('');
            LvAdd(Filename,0,0,item1);
            FileSize := (F.nFileSizeHigh shl 32) or (F.nFileSizeLow);
            if F.dwFileAttributes and faDirectory = faDirectory then
            begin
                item1.ImageIndex:=1;
                item1.SubItems.Strings[0]:='目录';//文件夹
                item1.SubItems.Strings[1]:= '0';
            end
            else
            begin
                item1.ImageIndex:=0;
                item1.SubItems.Strings[0]:='';//文件夹
                item1.SubItems.Strings[1]:= FileSizeToString(FileSize);
                item1.SubItems.Strings[2]:=
                GetFileTypeDescription(FRemotePath + FileName, True);
            end;
        end;
        R := FindNextFile(Enum, F);
    end;
    finally
        windows.FindClose(Enum);
        RemoteSort:=False;
    end;
end;
procedure TFTPMain.FormCreate(Sender: TObject);
var
    i:integer;
    lvcol:TListColumn;
begin
    lvcol:=lview1.Columns.Add();
    lvcol.Caption:='名称';
    lvcol.width:=130;
    lvcol:=lview1.Columns.Add();
    lvcol.Caption:='';
    lvcol.width:=40;
    lvcol:=lview1.Columns.Add();
    lvcol.Caption:='大小';
    lvcol.width:=80;
    lvcol:=lview1.Columns.Add();
    lvcol.Caption:='日期';
    lvcol.width:=80;
    lvcol:=lview1.Columns.Add();
    lvcol.Caption:='属性';
    lvcol.width:=40;
    lvcol:=lview2.Columns.Add();
    lvcol.Caption:='名称';
    lvcol.width:=130;
    lvcol:=lview2.Columns.Add();
    lvcol.Caption:='';
    lvcol.width:=40;
    lvcol:=lview2.Columns.Add();
    lvcol.Caption:='大小';
    lvcol.width:=80;
    lvcol:=lview2.Columns.Add();
    lvcol.Caption:='日期';
    lvcol.width:=80;
    lvcol:=lview2.Columns.Add();
    lvcol.Caption:='属性';
    lvcol.width:=40;
    LocalUpdateListing;
    lvcol.width:=40;
    FLocalPath:=GetCurrentDir()+'\';
    gbox1.Caption:=FLocalPath;
end;

procedure TFTPMain.LvAdd(Caption1:string;imageidx1:integer;selimage:integer;item2:TListItem);
begin
    item2.Caption:=caption1;
    item2.ImageIndex:= imageidx1;
end;

function TFTPMain.GetFileTypeDescription(const Name: string; UseAttr: Boolean): string;
var
    Info: TSHFileInfo;
    Flags: Cardinal;
begin
    FillChar(Info, SizeOf(Info), 0);
    Flags := SHGFI_TYPENAME;
    if UseAttr then Flags := Flags or SHGFI_USEFILEATTRIBUTES;
    SHGetFileInfo(PChar(Name), 0, Info, SizeOf(Info), Flags);
        Result := Info.szTypeName;
end;

function TFTPMain.FileSizeToString(const Size: Int64): string;
var
    S: Integer;
begin
    if Size < 1024 then
        Result := IntToStr(Size) + ' Bytes';
    S := Size div 1024;
    if S = 0 then S := 1;
    if S < 1024 then
        Result := IntToStr(S) + ' KB'
    else
    begin
        S := S div 1024;
        if S = 0 then S := 1;
        Result := IntToStr(S) + ' MB';
    end;
 
end;

procedure TFTPMain.LView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
    if Item = nil then Exit;
    if item.SubItems.Strings[0]='目录' then
       (sender as TCustomListView).Canvas.Font.Color:=clBlue;
end;

function TFTPMain.GetFileTypeIcon(const Name: string; UseAttr: Boolean): HICON;
var
  Info: TSHFileInfo;
  Flags: Cardinal;
begin
  FillChar(Info, SizeOf(Info), 0);
  Flags := SHGFI_ICON or SHGFI_SMALLICON;
  if UseAttr then Flags := Flags or SHGFI_USEFILEATTRIBUTES;
  SHGetFileInfo(PChar(Name), 0, Info, SizeOf(Info), Flags);
  Result := Info.hIcon;
end;

procedure TFTPMain.LView2CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if Item = nil then Exit;
  if item.SubItems.Strings[0]='目录' then
      (sender as TCustomListView).Canvas.Font.Color:=clBlue;
end;

procedure TFTPMain.LView2DblClick(Sender: TObject);
var
pos1:integer;
tmpstr:string;
begin
    if lview2.SelCount>0 then
    begin
        if (lview2.Selected.SubItems[0]='目录') and
        (lview2.selected.caption<>'..') then
        begin
            FRemotePath := FRemotePath +lview2.Selected.Caption+'\';
            gbox2.Caption:=Fremotepath;
            RemoteUpdateListing;
        end
        else if lview2.selected.caption='..' then
        begin//上一级目录
            if pos('\',FRemotePath)>0 then
                delete(FRemotePath,length(FRemotePath),1);
            tmpstr:=ReverseString(FRemotePath);
            pos1:= pos('\',tmpstr);
            if pos1>0 then
                Fremotepath:=copy(Fremotepath,1,length(FRemotepath)-pos1+1)
            else Fremotepath:='';
            gbox2.Caption:=Fremotepath;
            RemoteUpdateListing;
        end;
        begin
            SbtnDown.Click;
        end;
    end;
end;

procedure TFTPMain.LView1DblClick(Sender: TObject);
var
pos1:integer;
tmpstr:string;
begin
    if lview1.SelCount>0 then
    begin
        if (lview1.Selected.SubItems[0]='目录') and
        (lview1.selected.caption<>'..') then
        begin
            FLocalPath := FLocalPath +lview1.Selected.Caption+'\';
            gbox1.Caption:=Flocalpath;
            LocalUpdateListing;
        end
        else if lview1.selected.caption='..' then
        begin//上一级目录
            if pos('\',FLocalPath)>0 then
                delete(FLocalPath,length(FLocalPath),1);
            tmpstr:=ReverseString(FLocalPath);
            pos1:= pos('\',tmpstr);
            if pos1>0 then
                FLocalPath:=copy(FLocalPath,1,length(FLocalPath)-pos1+1)
            else FLocalPath:='';
            gbox1.Caption:=Flocalpath;
            LocalUpdateListing;
        end
        else
        begin
            SbtnUpload.Click;
        end;
    end;
end;

procedure TFTPMain.ckAnonymousClick(Sender: TObject);
begin
    if ckAnonymous.Checked then
    begin
        edituser.text:='Anonymous';
        editpass.text:='[e-mail]';
    end
    else
    begin
        edituser.text:='';
        editpass.text:='';
    end;
end;

procedure TFTPMain.EditIPKeyPress(Sender: TObject; var Key: Char);
begin
        if key=#13 then SbtnConnect.click;
end;

procedure TFTPMain.drive1Change(Sender: TObject);
begin
    if pos(trim(drive1.Drive)+':\',Flocalpath)<>1 then
    begin
        Flocalpath:=drive1.Drive+':\';
        gbox1.Caption:=Flocalpath;
        LocalUpdateListing;
    end;
end;
end.