Как добавить данные в третий столбец ListView из определенной точки? - PullRequest
0 голосов
/ 17 мая 2018

Моя цель здесь - добавить информацию, соответствующую размеру каждого файла (только файла), который должен находиться в третьем столбце ListView.

Моя попытка ниже была безуспешной. Где не так?

type
  TForm1 = class(TForm)
    btn1: TButton;
    LV1: TListView;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ListSize: TStrings;

implementation

{$R *.dfm}

function ListFolders(Directory: String): string;
var
  FileName, Dirlist: string;
  SearchRec: TWin32FindData;
  FindHandle: THandle;
  ReturnStr: string;
begin
  ReturnStr := '';

  try
    FindHandle := FindFirstFile(PChar(Directory + '*.*'), SearchRec);
    if FindHandle <> INVALID_HANDLE_VALUE then
      repeat
        FileName := SearchRec.cFileName;
        if ((SearchRec.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) then
          Dirlist := Dirlist + (FileName + #13);
      until FindNextFile(FindHandle, SearchRec) = False;
  finally
    Winapi.Windows.FindClose(FindHandle);
  end;
  ReturnStr := (Dirlist);
  Result := ReturnStr;
end;

function FileSizeStr(FileName: string): string;
const
  // K = Int64(1000);     // Comment out this line OR
  K = Int64(1024); // Comment out this line
  M = K * K;
  G = K * M;
  T = K * G;
var
  size: Int64;
  handle: integer;
begin
  handle := FileOpen(FileName, fmOpenRead);
  if handle = -1 then
    Result := 'Unable to open file ' + FileName
  else
    try
      size := FileSeek(handle, Int64(0), 2);
      if size < K then
        Result := Format('%d bytes', [size])
      else if size < M then
        Result := Format('%f KB', [size / K])
      else if size < G then
        Result := Format('%f MB', [size / M])
      else if size < T then
        Result := Format('%f GB', [size / G])
      else
        Result := Format('%f TB', [size / T]);
    finally
      FileClose(handle);
    end;
end;

function GetFiles(FileName, Ext: String): String;
Var
  SearchFile: TSearchRec;
  FindResult: integer;
  ListFiles: TStrings;
begin
  ListFiles := TStringlist.Create;
  ListSize := TStringlist.Create;
  FindResult := FindFirst(FileName + Ext, faArchive, SearchFile);
  try
    While FindResult = 0 do
    begin
      Application.ProcessMessages;
      ListFiles.Add(SearchFile.Name);
      ListSize.Add(FileSizeStr(FileName + SearchFile.Name));
      FindResult := FindNext(SearchFile);
    end;
  finally
    FindClose(SearchFile)
  end;
  Result := ListFiles.Text;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  L: TListItem;
  vListFolders, vListSize, vListFiles: TStringlist;
  i, j, k: integer;
begin

  LV1.Clear;

  vListFolders := TStringlist.Create;
  vListFiles := TStringlist.Create;
  vListSize := TStringlist.Create;

  vListFolders.Text := ListFolders('C:\');
  vListFiles.Text := GetFiles('C:\', '*.*');
  vListSize.Text := ListSize.Text;

  for i := 0 to vListFolders.Count - 1 do
  begin
    L := LV1.Items.Add;
    L.Caption := vListFolders.Strings[i];
    L.SubItems.Add('Folder');
  end;

  for j := 0 to vListFiles.Count - 1 do
  begin
    L := LV1.Items.Add;
    L.Caption := vListFiles.Strings[j];
    L.SubItems.Add('File');
  end;

  ///////////////////////////////////////

  for k := 0 to vListSize.Count - 1 do
  begin
    L := LV1.Items.Add;
    L.Caption := vListSize.Strings[k];
    // L.SubItems.Add(vListSize.Strings[k]);
  end;

  ///////////////////////////////////////

  vListFolders.Free;
  vListFiles.Free;
  vListSize.Free;
end;

enter image description here


EDITION

Мне нужно обрабатывать каждый столбец по отдельности, потому что эти данные будут поступать со стороны клиента моего приложения удаленного администрирования и запрашиваются для каждой информации отдельно. Сначала запрашивается Папки -> идет Папки, после Файлы -> идет Файлы и, наконец, размер каждого файла, который хранится на стороне клиента, так же, как было показано выше. Рассмотрим код Button как мой приемник (на стороне сервера): D.

Например (получение папок и после, запрос файлов):

if Pos('<|Folder|>', s) > 0 then
      begin
        s2 := s;
        Delete(s2, 1, Pos('<|Folder|>', s2) + 9);
        s2 := Copy(s2, 1, Pos('<<|', s2) - 1);
        Lista := TStringList.Create;
        Lista.Text := s2;
        // showmessage('ra');
        L2 := Form1.LV1.FindCaption(0, intToStr(Socket.Handle), false, true, false);
        (L2.SubItems.Objects[4] as TForm3).ListView1.Clear;
        // Application.MessageBox(PChar(Lista.Text), ' ', 48);
        for i := 0 to Lista.count - 1 do
        begin

          L := (L2.SubItems.Objects[4] as TForm3).ListView1.Items.Add;
          L.ImageIndex := 0;

          Sleep(10);
          L.Caption := Lista.Strings[i];
          L.SubItems.Add('Folder');
        end;

        if (L2.SubItems.Objects[4] as TForm3).ListView1.Items[0].Caption = '..' then
           (L2.SubItems.Objects[4] as TForm3).ListView1.Items[0].ImageIndex := 5;

        Lista.Free;
        Socket.SendText('<|Files|>' + (L2.SubItems.Objects[4] as TForm3).Edit1.Text + '<<|');
      end;

1 Ответ

0 голосов
/ 17 мая 2018

Ваша функция GetFiles(...) не более чем добавляет два значения одновременно к двум различным спискам TStringlist.

function GetFiles(FileName, Ext: String): String;
    ...
    ListFiles.Add(SearchFile.Name);
    ListSize.Add(FileSizeStr(FileName + SearchFile.Name));
    ...

Вы можете добавить его в прямой просмотр списка

var
  ListFiles: TStrings;
  ListSize : TStrings;
.....
.....

function GetFiles(FileName, Ext: String): String;
Var
  SearchFile: TSearchRec;
  FindResult: integer;
  cCount    : Integer;
begin
  Result     := 'NOT NEEDED';
  cCount     := LV1.Items.Count -1;

  FindResult := FindFirst(FileName + Ext, faArchive, SearchFile);
  try
    While FindResult = 0 do
    begin

      inc(cCount);
      LV1.Items.Add;
      LV1.Items[cCount].Caption := SearchFile.Name;
      LV1.Items[cCount].SubItems.Add('File');
      LV1.Items[cCount].SubItems.Add(FileSizeStr(FileName + SearchFile.Name));
      // C:\ + SearchFile.Name

    FindResult := FindNext(SearchFile);
    end;
  finally
    windows.FindClose(SearchFile)
  end;
end;

Если вы обязательно хотите сделать это в procedure TForm1.btn1Click(...)

var
  ListFiles: TStrings;
  ListSize : TStrings;
.....

.....

function GetFiles(FileName, Ext: String): String;
Var
  SearchFile: TSearchRec;
  FindResult: integer;
begin
  FindResult := FindFirst(FileName + Ext, faArchive, SearchFile);
  try
    While FindResult = 0 do
    begin
      ListFiles.Add(SearchFile.Name);
      ListSize.Add(FileSizeStr(FileName + SearchFile.Name));
      FindResult := FindNext(SearchFile);
    end;
  finally
    windows.FindClose(SearchFile)
  end;
  Result := 'NOT NEEDED';
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  vListFolders : TStringlist;
  i, j, cCount : integer;
begin
  ListFiles    := TStringlist.Create;
  ListSize     := TStringlist.Create;
  vListFolders := TStringlist.Create;

  LV1.Items.Clear;
  try   
    vListFolders.Text := ListFolders('C:\');
    GetFiles('C:\', '*.*'); // Add to ListFiles, ListSize Name and size  

  // Old Only for folders ...
  // ========================================

    for i := 0 to vListFolders.Count - 1 do
    begin
      L := LV1.Items.Add;
      L.Caption := vListFolders.Strings[i];
      L.SubItems.Add('Folder');
    end;

  // New for name and size
  // ========================================
    cCount := LV1.Items.Count -1;

    if ListFiles.Count = ListSize.Count then
    begin

     for j := 0 to ListFiles.Count - 1 do
     begin
        Inc(cCount);
        LV1.Items.Add;
        LV1.Items[cCount].Caption := ListFiles[j];    // File Name
        LV1.Items[cCount].SubItems.Add('File');       // File
        LV1.Items[cCount].SubItems.Add(ListSize[j]);  // Formatted Size
     end; // for j

    end else begin
        Inc(cCount);
        LV1.Items.Add;
        LV1.Items[cCount].Caption := 'File List BROKEN';
    end;

  finally
    vListFolders.Free;
    ListFiles.Free;
    ListSize .Free;
  end;

end; // btn1Click(...)
...