unit1.~pas

vc-mfc编程实例 很简单的东西,以后回多传自己的东西

   IniFile := TIniFile.Create(IniFileName);
   HostNameEdit.Text:=IniFile.ReadString(ProfileName, 'HostName', '');
   InitialLocalDirEdit.Text:=IniFile.ReadString(ProfileName,'InitialLocalDir','C:\');
   InitialDirEdit.Text:=IniFile.ReadString(ProfileName, 'InitialDir', '');
   UserNameEdit.Text:=IniFile.ReadString(ProfileName, 'UserName', '');
   PasswordEdit.Text:=
      StrDecrypt(Base64Decode(IniFile.ReadString(ProfileName, 'Password', '')));
   PortEdit.Text:=IntToStr(IniFile.ReadInteger(ProfileName, 'Port', 21));
   ForceLowerCB.Checked:=IniFile.ReadBool(ProfileName, 'ForceLower', True);
   AutoDirCB.Checked:=IniFile.ReadBool(ProfileName, 'AutoDir', True);
   IniFile.Free;
end;

procedure TForm1.SiteCBChange(Sender: TObject);
begin
   ReadProfile(SiteCB.Text);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
   CurSite: String;
   IniFile: TIniFile;
   i: Integer;
begin
   FileNames.Free;
   IniFile := TIniFile.Create(IniFileName);
   // Sort the site profile entries
   IniFile.EraseSection('Profiles');
   CurSite:=SiteCB.Text; // remember the current site
   SiteCB.Sorted:=True;  // sort the combo box list of profiles
   for i :=0 to SiteCB.Items.Count - 1 do
      IniFile.WriteString('Profiles', 'Name'+IntToStr(i), SiteCB.Items[i]);
   // Now that we sorted the list, we need to find where our current
   // site is in the new order:
   i:=SiteCB.Items.IndexOf(CurSite);
   if i = -1 then
      i:=0;   // we couldn't find the current site - unlikely!
   IniFile.WriteInteger('LastUsed', 'Profile', i);
   IniFile.Free;
end;

function TForm1.StrEncrypt(const S: String): String;
const
  C1 = 52845;  { well-chosen values for seeds to encryption }
  C2 = 22719;
var
  I: Integer;
  Key: Word;
begin
  Key:=7373;
 {$IFDEF Win32}
  SetLength(Result,Length(S));
 {$ELSE}
  Result[0]:=Chr(Length(S));
 {$ENDIF}
 {$R-}
 {$Q-}
  for I := 1 to Length(S) do begin
    Result[I] := char(Ord(S[I]) xor (Key shr 8));
    Key := (Ord(Result[I]) + Key) * C1 + C2;
  end;
end;

function TForm1.StrDecrypt(const S: String): String;
const
  C1 = 52845;  { well-chosen values for seeds to encryption }
  C2 = 22719;
var
  I: Integer;
  Key: Word;
begin
  Key:=7373;
 {$IFDEF Win32}
  SetLength(Result,Length(S));
 {$ELSE}
  Result[0]:=Chr(Length(S));
 {$ENDIF}
 {$R-}
 {$Q-}
  for I := 1 to Length(S) do begin
    Result[I] := char(Ord(S[I]) xor (Key shr 8));
    Key := (Ord(S[I]) + Key) * C1 + C2;
  end;
end;

// Base64 code is by Tom Bradford of Beachdog Software
Const Base64Table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

Function TForm1.Base64Encode(Value : String) : String;
Var AIn   : Array[1..3] Of Byte;
    AOut  : Array[1..4] Of Byte;
    AWork : Array[1..3] Of Byte;
    I : Integer;
    O : LongInt;
Begin
   Result := '';
   I := 1;
   O := Length(Value);
   Case Length(Value) Mod 3 Of
      1 : Value := Value + #0 + #0;
      2 : Value := Value + #0;
   End;
   While I < Length(Value) Do
      Begin
         AIn[1] := Byte(Value[I]);
         AIn[2] := Byte(Value[I+1]);
         AIn[3] := Byte(Value[I+2]);

         AOut[1] := Byte(AIn[1] Shr 2);
         AWork[1] := Byte(AIn[1] Shl 4);
         AWork[2] := Byte(AWork[1] And $30);
         AWork[3] := Byte(AIn[2] Shr 4);
         AOut[2] := Byte(AWork[2] Or AWork[3]);
         AWork[1] := Byte(AIn[2] Shl 2);
         AWork[2] := Byte(AWork[1] And $3C);
         AWork[3] := Byte(AIn[3] Shr 6);
         AOut[3] := Byte(AWork[2] Or AWork[3]);
         AOut[4] := Byte(AIn[3] And $3F);

         Inc(I, 3);
         Result := Result + Base64Table[AOut[1]+1] + Base64Table[AOut[2]+1] + Base64Table[AOut[3]+1] + Base64Table[AOut[4]+1];
      End;
   If O Mod 3 > 0 Then Result[Length(Result)] := '=';
   If O Mod 3 = 1 Then Result[Length(Result)-1] := '=';
End;

Function TForm1.Base64Decode(Value : String) : String;
Var AIn   : Array[1..4] Of Byte;
    AOut  : Array[1..3] Of Byte;
    AWork : Array[1..3] Of Byte;
    I : Integer;
    C : Integer;
Begin
   Result := '';
   I := 1;
   While I < Length(Value) Do
   Begin
      C := 3;
      FillChar(AWork, SizeOf(AWork), #0);
      FillChar(AOut, SizeOf(AWork), #0);
      AIn[1] := Byte(Pos(Value[I],Base64Table)-1);
      AIn[2] := Byte(Pos(Value[I+1],Base64Table)-1);
      AIn[3] := Byte(Pos(Value[I+2],Base64Table)-1);
      AIn[4] := Byte(Pos(Value[I+3],Base64Table)-1);
      If Value[I+3]='=' Then
      Begin
         C := 2;
         AIn[4] := 0;
         If Value[I+2]='=' Then
         Begin
            C := 1;
            AIn[3] := 0;
         End;
      End;
      AWork[2] := Byte(AIn[1] Shl 2);
      AWork[3] := Byte(AIn[2] Shr 4);
      AOut[1] := Byte(AWork[2] Or AWork[3]);
      AWork[2] := Byte(AIn[2] Shl 4);
      AWork[3] := Byte(AIn[3] Shr 2);
      AOut[2] := Byte(AWork[2] Or AWork[3]);
      AWork[2] := Byte(AIn[3] Shl 6);
      AOut[3] := Byte(AWork[2] Or AIn[4]);
      Result := Result + Char(AOut[1]);
      If C > 1 Then
         Result := Result + Char(AOut[2]);
      If C > 2 Then
         Result := Result + Char(AOut[3]);
      Inc(I, 4);
   End;
End;

procedure TForm1.UploadAll;
begin
   with FtpClient1 do
   begin
      if CopyForm.RadioGroup1.ItemIndex = 0 then
         Binary:=True
      else
         Binary:=False;
      TypeSet; // Tell the other end to use binary or ascii mode
      FilesLeft := FileNames.Count;
      UploadNext;
   end;
end;

procedure TForm1.UploadNext;
begin
   with FtpClient1 do
   begin
      Dec(FilesLeft);
      if FilesLeft > -1 then
      begin
         HostDirName:=CopyForm.RemotedirEdit.Text;
         if ForceLowerCB.Checked then
            HostFileName:=Lowercase(ExtractFileName(FileNames.Strings[FilesLeft]))
         else
            HostFileName:=ExtractFileName(FileNames.Strings[FilesLeft]);
         LocalFileName:=FileNames.Strings[FilesLeft];
         Memo1.Lines.Add('put ' + LocalFileName + ' ' + HostFileName);
         CopyForm.Memo1.Lines.Add('put ' + LocalFileName + ' ' + HostFileName);
         Put;
      end;
   end;
end;

procedure TForm1.View;
begin
   with FtpClient1 do
   begin
      Binary:=False;
      TypeSet; // Tell the other end to use ascii mode
      FilesLeft := FileNames.Count;
      HostDirName:=CopyForm.RemotedirEdit.Text;
      ViewFileName:=FileNames.Strings[0];
      LocalFileName:=WinTempDir + ViewFileName;
      HostFileName:=ViewFileName;
      Memo1.Lines.Add('get ' + HostFileName + ' ' + LocalFileName);
      CopyForm.Memo1.Lines.Add('get ' + HostFileName + ' ' + LocalFileName);
      Get;
   end;
end;

procedure TForm1.ViewTheFile;
var
   zAppName:array[0..512] of char;
   zCurDir:array[0..255] of char;
   WorkDir:String;
   StartupInfo:TStartupInfo;
   ProcessInfo:TProcessInformation;
begin
   if not FileExists(WinTempDir + ViewFileName) then
      Exit;
   // The filename arg for Wordpad has double quotes around it
   StrPCopy(zAppName, 'C:\PROGRA~1\ACCESS~1\wordpad.exe "'
                    + WinTempDir + ViewFileName + '"');
   GetDir(0,WorkDir);
   StrPCopy(zCurDir,WorkDir);
   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
   StartupInfo.cb := Sizeof(StartupInfo);
   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
   StartupInfo.wShowWindow := SW_SHOWDEFAULT;
   if not CreateProcess(nil,
      zAppName,                      { pointer to command line string }
      nil,                           { pointer to process security attributes }
      nil,                           { pointer to thread security attributes }
      false,                         { handle inheritance flag }
      CREATE_NEW_CONSOLE or          { creation flags }
      NORMAL_PRIORITY_CLASS,
      nil,                           { pointer to new environment block }
      nil,                           { pointer to current directory name }
      StartupInfo,                   { pointer to STARTUPINFO }
      ProcessInfo) then
         ShowMessage('Error spawning wordpad.exe') { pointer to PROCESS_INF }
   else
   begin
      WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
      //GetExitCodeProcess(ProcessInfo.hProcess,Result);
   end;
   DeleteFile(WinTempDir + ViewFileName);
end;

procedure TForm1.DownloadAll;
begin
   with FtpClient1 do
   begin
      if CopyForm.RadioGroup1.ItemIndex = 0 then
         Binary:=True
      else
         Binary:=False;
      TypeSet; // Tell the other end to use binary or ascii mode
      FilesLeft := FileNames.Count;
      DownLoadNext;
   end;
end;

procedure TForm1.DownloadNext;
begin
   with FtpClient1 do
   begin
      Dec(FilesLeft);
      if FilesLeft > -1 then
      begin
         HostDirName:=CopyForm.RemotedirEdit.Text;
         if ForceLowerCB.Checked then
            LocalFileName:=CopyForm.AppendSlash(CopyForm.DirectoryListBox1.Directory)
               + Lowercase(FileNames.Strings[FilesLeft])
         else
            LocalFileName:=CopyForm.AppendSlash(CopyForm.DirectoryListBox1.Directory)
               + FileNames.Strings[FilesLeft];
         HostFileName:=FileNames.Strings[FilesLeft];
         Memo1.Lines.Add('get ' + HostFileName + ' ' + LocalFileName);
         CopyForm.Memo1.Lines.Add('get ' + HostFileName + ' ' + LocalFileName);
         Get;
      end;
   end;
end;

procedure TForm1.RemoteDelete;
begin
   with FtpClient1 do
   begin
      Dec(FilesLeft);
      if FilesLeft > -1 then
      begin
         HostDirName:=CopyForm.RemotedirEdit.Text;
         HostFileName:=FileNames.Strings[FilesLeft];
         Memo1.Lines.Add('Del ' + HostFileName + ' ' + LocalFileName);
         CopyForm.Memo1.Lines.Add('Del ' + HostFileName + ' ' + LocalFileName);
         Dele;
      end;
   end;
end;

procedure TForm1.LocalDelete;
begin
   while FilesLeft > 0 do
   begin
      Dec(FilesLeft);
      DeleteFile(FileNames.Strings[FilesLeft]);
      Memo1.Lines.Add('Del ' + FileNames.Strings[FilesLeft]);
      CopyForm.Memo1.Lines.Add('Del ' + FileNames.Strings[FilesLeft]);
   end;
   CopyForm.FileListBox1.Update;
   CopyForm.Show;
end;

function TForm1.LookupRequest(RqType: TFtpRequest): String;
begin
   case RqType of
      ftpNone: result:='none';
      ftpOpenAsync: result:='OpenAsync';
      ftpUserAsync: result:='UserAsync';
      ftpPassAsync: result:='PassAsync';
      ftpCwdAsync: result:='CwdAsync';
      ftpConnectAsync: result:='ConnectAsync';
      ftpReceiveAsync: result:='ReceiveAsync';
      ftpDirAsync: result:='DirAsync';
      ftpLsAsync: result:='LsAsync';
      ftpPortAsync: result:='PortAsync';
      ftpGetAsync: result:='GetAsync';
      ftpDirectoryAsync: result:='DirectoryAsync';
      ftpListAsync: result:='ListAsync';
      ftpSystemAsync: result:='SystemAsync';
      ftpSystAsync: result:='SystAsync';
      ftpQuitAsync: result:='QuitAsync';
      ftpSizeAsync: result:='SizeAsync';
      ftpPutAsync: result:='PutAsync';
      ftpAppendAsync: result:='AppendAsync';
      ftpFileSizeAsync: result:='FileSizeAsync';
      ftpRqAbort: result:='RqAbort';
      ftpMkdAsync: result:='MkdAsync';
      ftpRmdAsync: result:='RmdAsync';
      ftpRenameAsync: result:='RenameAsync';
      ftpDeleAsync: result:='DeleAsync';
      ftpRenAsync: result:='RenAsync';
      ftpRenToAsync: result:='RenToAsync';
      ftpRenFromAsync: result:='RenFromAsync';
      ftpDeleteAsync: result:='DeleteAsync';
      ftpMkdirAsync: result:='MkdirAsync';
      ftpRmdirAsync: result:='RmdirAsync';
      ftpPwdAsync: result:='PwdAsync';
      ftpQuoteAsync: result:='QuoteAsync';
      ftpCDupAsync: result:='CDupAsync';
      ftpDoQuoteAsync: result:='DoQuoteAsync';
      ftpTransmitAsync: result:='TransmitAsync';
      ftpTypeSetAsync: result:='TypeSetAsync';
      ftpRestAsync: result:='RestAsync';
      ftpRestGetAsync: result:='RestGetAsync';
      ftpRestartGetAsync: result:='RestartGetAsync';
   else
      result:='unknown';
   end;
end;

end.