mainform.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 925 行 · 第 1/2 页

procedure TForm1.CloseCurrentHandle;
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Closing active handle');
  SftpClient.CloseHandle(CurrentHandle);
end;

function TForm1.WritePermissions(Attributes : TElSftpFileAttributes) : string;
begin
  Result := '';
  if Attributes.Directory then
    Result := Result + 'd';
  if Attributes.UserRead then
    Result := Result + 'r'
  else
    Result := Result + '-';
  if Attributes.UserWrite then
    Result := Result + 'w'
  else
    Result := Result + '-';
  if Attributes.UserExecute then
    Result := Result + 'x'
  else
    Result := Result + '-';
  if Attributes.GroupRead then
    Result := Result + 'r'
  else
    Result := Result + '-';
  if Attributes.GroupWrite then
    Result := Result + 'w'
  else
    Result := Result + '-';
  if Attributes.GroupExecute then
    Result := Result + 'x'
  else
    Result := Result + '-';
  if Attributes.OtherRead then
    Result := Result + 'r'
  else
    Result := Result + '-';
  if Attributes.OtherWrite then
    Result := Result + 'w'
  else
    Result := Result + '-';
  if Attributes.OtherExecute then
    Result := Result + 'x'
  else
    Result := Result + '-';
end;

procedure TForm1.OutputFileList;
var
  I : integer;
begin
  StringGrid1.Cells[0, 0] := 'Name';
  StringGrid1.Cells[1, 0] := 'Size';
  StringGrid1.Cells[2, 0] := 'Permissions';
  StringGrid1.RowCount := CurrentFileList.Count + 1;
  for I := 0 to CurrentFileList.Count - 1 do
  begin
    StringGrid1.Cells[0, I + 1] := TElSftpFileInfo(CurrentFileList.Items[I]).Name;
    StringGrid1.Cells[1, I + 1] := IntToStr(TElSftpFileInfo(CurrentFileList.Items[I]).Attributes.Size);
    StringGrid1.Cells[2, I + 1] := WritePermissions(TElSftpFileInfo(CurrentFileList.Items[I]).Attributes);
  end;
end;

procedure TForm1.StringGrid1DblClick(Sender: TObject);
var
  Info : TElSftpFileInfo;
begin
  if StringGrid1.Row = 0 then
    Exit;
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Info := TElSftpFileInfo(CurrentFileList.Items[StringGrid1.Row - 1]);
  if Info.Attributes.Directory then
  begin
    ChangeDir(Info.Name);
  end;
end;

procedure TForm1.ChangeDir(Dir : string);
begin
  Log('Trying to change directory to "' + Dir + '"');
  RelDir := Dir;
  SftpClient.OpenDirectory(AbsPath(Dir));
  State := STATE_CHANGE_DIR;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  S : string;
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  S := InputBox('New directory...', 'Enter directory name:', '');
  if S = '' then
  begin
    Log('Invalid directory name, creation cancelled.');
    Exit;
  end;
  MakeDir(S);
end;

procedure TForm1.MakeDir(Dir : string);
var
  Attrs : TElSftpFileAttributes;
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Creating directory "' + Dir + '"');
  Attrs := TElSftpFileAttributes.Create;
  Attrs.IncludedAttributes := [];
  SftpClient.MakeDirectory(AbsPath(Dir), Attrs);
  State := STATE_MAKE_DIR;
  Attrs.Free;
end;

procedure TForm1.RenameFile(OldName, NewName : string);
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Renaming "' + OldName + '" to "' + NewName + '"');
  SftpClient.RenameFile(AbsPath(OldName), AbsPath(NewName));
  State := STATE_RENAME;
end;

procedure TForm1.DeleteDir(Name : string);
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Removing directory "' + Name + '"');
  SftpClient.RemoveDirectory(AbsPath(Name));
  State := STATE_REMOVE;
end;

procedure TForm1.DeleteFile(Name : string);
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Removing file "' + Name + '"');
  SftpClient.RemoveFile(AbsPath(Name));
  State := STATE_REMOVE;
end;

procedure TForm1.DownloadFile(Info : TElSftpFileInfo; LocalName : string);
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Starting file download, "' + Info.Name + '"');
  AssignFile(CurrentFile, LocalName);
  Rewrite(CurrentFile, 1);
  CurrentFileOffset := 0;
  CurrentFileSize := Info.Attributes.Size;
  SftpClient.OpenFile(AbsPath(Info.Name), [fmRead], nil);
  State := STATE_DOWNLOAD_OPEN;
end;

procedure TForm1.UploadFile(LocalFile : string);
var
  FName : string;
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  Log('Starting file upload, "' + LocalFile + '"');
  FName := ExtractFileName(LocalFile);
  AssignFile(CurrentFile, LocalFile);
  Reset(CurrentFile, 1);
  CurrentFileOffset := 0;
  CurrentFileSize := FileSize(CurrentFile);
  SftpClient.CreateFile(AbsPath(FName));
  State := STATE_UPLOAD_OPEN;
end;

procedure TForm1.WriteNextBlockToFile;
var
  Buf : array[0..FILE_BLOCK_SIZE - 1] of byte;
  Transferred : integer;
begin
  if not scktClient.Active then
  begin
    Log('Error: not connected');
    Exit;
  end;
  if CurrentFileOffset >= CurrentFileSize then
  begin
    State := STATE_CLOSE_HANDLE;
    Form2.Close;
    CloseCurrentHandle;
    Exit;
  end;
  BlockRead(CurrentFile, Buf[0], FILE_BLOCK_SIZE, Transferred);
  SftpClient.Write(CurrentHandle, CurrentFileOffset, @Buf[0], Transferred);
  Inc(CurrentFileOffset, Transferred);  
end;

function TForm1.FormatPath(Path : string) : string;
var
  Lst : TStringList;
  I, Ind : integer;
begin
  Lst := TStringList.Create;
  Ind := Pos('/', Path);
  while Ind > 0 do
  begin
    Lst.Add(Copy(Path, 1 ,Ind - 1));
    Path := Copy(Path, Ind + 1, Length(Path));
    Ind := Pos('/', Path);
  end;
  Lst.Add(Path);
  if Lst.Count > 2 then
  begin
    if (Lst.Strings[Lst.Count - 1] = '..') and (Lst.Strings[Lst.Count - 2] <> '..') then
    begin
      Lst.Delete(Lst.Count - 1);
      Lst.Delete(Lst.Count - 1);
    end;
  end;
  Result := '';
  for I := 0 to Lst.Count - 1 do
    Result := Result + Lst.Strings[I] + '/';
  if Length(Result) > 1 then
    Result := Copy(Result, 1, Length(Result) - 1);
  Lst.Free;
end;

procedure TForm1.RequestAbsolutePath(Path : string);
begin
  SftpClient.RequestAbsolutePath(Path);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Info : TElSftpFileInfo;
  S : string;
begin
  if StringGrid1.Row = 0 then
    Exit;
  Info := TElSftpFileInfo(CurrentFileList.Items[StringGrid1.Row - 1]);
  S := InputBox('Rename...', 'Enter NEW name:', '');
  if S = '' then
  begin
    Log('Invalid filename, renaming cancelled.');
    Exit;
  end;
  RenameFile(Info.Name, S);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  Info : TElSftpFileInfo;
begin
  if StringGrid1.Row = 0 then
    Exit;
  if MessageDlg('Do you really want to remove this item?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    Info := TElSftpFileInfo(CurrentFileList.Items[StringGrid1.Row - 1]);
    if Info.Attributes.Directory then
      DeleteDir(Info.Name)
    else
      DeleteFile(Info.Name);
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  Info : TElSftpFileInfo;
begin
  if StringGrid1.Row = 0 then
    Exit;
  Info := TElSftpFileInfo(CurrentFileList.Items[StringGrid1.Row - 1]);

  if Info.Attributes.Directory then
  begin
    Log('Can not download directory. Please choose ordinary file.');
    Exit;
  end;
  if SaveDialog1.Execute then
  begin
    DownloadFile(Info, SaveDialog1.Filename);
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    UploadFile(OpenDialog1.Filename);
  end;
end;

procedure TForm1.scktClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Log('TCP Connection closed');
  btnConnect.Caption := 'Disconnect';
end;

procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  C, R : integer;
begin
  StringGrid1.MouseToCell(X, Y, C, R);
  if R > 0 then
  begin
    if (CurrentFileList.Count > R) and Assigned(CurrentFileList.Items[R - 1]) then
      Edit4.Text := TElSftpFileInfo(CurrentFileList.Items[R - 1]).LongName
  end
  else
    Edit4.Text := '';
end;

procedure TForm1.HandleSftpFileAttributes(Sender: TObject; Attributes:
    TElSftpFileAttributes);
var
  Info : TElSftpFileInfo;
begin
  Info := TElSftpFileInfo(CurrentFileList.Items[StringGrid1.Row - 1]);
  if saSize in Attributes.IncludedAttributes then
    Info.Attributes.Size := Attributes.Size;
  if saUID in Attributes.IncludedAttributes then
    Info.Attributes.UID := Attributes.UID;
  if saGID in Attributes.IncludedAttributes then
    Info.Attributes.GID := Attributes.GID;
  if saATime in Attributes.IncludedAttributes then
    Info.Attributes.ATime := Attributes.ATime;
  if saMTime in Attributes.IncludedAttributes then
    Info.Attributes.MTime := Attributes.MTime;

  Info.Attributes.Directory := Attributes.Directory;
  if saPermissions in Attributes.IncludedAttributes then
  begin
    Info.Attributes.UserRead := Attributes.UserRead;
    Info.Attributes.UserWrite := Attributes.UserWrite;
    Info.Attributes.UserExecute := Attributes.UserExecute;

    Info.Attributes.GroupRead := Attributes.GroupRead;
    Info.Attributes.GroupWrite := Attributes.GroupWrite;
    Info.Attributes.GroupExecute := Attributes.GroupExecute;

    Info.Attributes.OtherRead := Attributes.OtherRead;
    Info.Attributes.OtherWrite := Attributes.OtherWrite;
    Info.Attributes.OtherExecute := Attributes.OtherExecute;
  end;

  SetCellInfo(StringGrid1.Row - 1, Info);
end;

procedure TForm1.btnUpdateFileInfoClick(Sender: TObject);
var
  Info : TElSftpFileInfo;
begin
  Info := TElSftpFileInfo(CurrentFileList.Items[StringGrid1.Row - 1]);
  Log('Requesting  download, "' + Info.Name + '"');
  SftpClient.RequestAttributes(AbsPath(Info.Name), false);
end;

procedure TForm1.SetCellInfo(Index : integer; Info : TElSftpFileInfo);
begin
  StringGrid1.Cells[0, Index + 1] := Info.Name;
  StringGrid1.Cells[1, Index + 1] := IntToStr(Info.Attributes.Size);
  StringGrid1.Cells[2, Index + 1] := WritePermissions(Info.Attributes);
end;

procedure TForm1.sbPrivateKeyClick(Sender: TObject);
begin
  if OpenDialog.Execute then
    edPrivateKey.Text := OpenDialog.Filename;
end;

procedure TForm1.HandleSSHClientKeyValidate(Sender: TObject;
  ServerKey: TElSSHKey; var Validate: Boolean);
var
  AlgLine: string;
begin
  if ServerKey.Algorithm = ALGORITHM_RSA then
    AlgLine := 'RSA'
  else if ServerKey.Algorithm = ALGORITHM_DSS then
    AlgLine := 'DSS'
  else
    AlgLine := 'unknown';

  Log(Format('Server key received (%s). Fingerprint is %s',
        [AlgLine, BeautifyBinaryString(DigestToStr(ServerKey.FingerprintMD5), ':')]));
  Validate := True;
end;

procedure TForm1.ClearFileList;
var
  I : integer;
begin
  for I := 0 to CurrentFileList.Count - 1 do
    TElSftpFileInfo(CurrentFileList[I]).Free;
  CurrentFileList.Clear;
end;

procedure TForm1.HandleClientAuthenticationKeyboard(Sender: TObject;
  Prompts: TStringList; Echo: TBits; Responses: TStringList);
var i : integer;
    S : string;
begin
  Responses.Clear;
  for i := 0 to Prompts.Count - 1 do
  begin
    if TfrmPrompt.Prompt(Prompts[i], Echo[i], S) then
      Responses.Add(S)
    else
      Responses.Add('');
  end;
end;

function TForm1.AbsPath(FileName: string): string;
begin
  if (Length(CurrentDir) = 0) or ((CurrentDir[Length(CurrentDir)] <> '\') and (CurrentDir[Length(CurrentDir)] <> '/')) then
    result := CurrentDir + '/' + FileName
  else
    result := CurrentDir + FileName;
end;

initialization

SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

end.