in meinem Projekt 'CP/M Image-File Explorer' habe ich nun das Hineinkopieren von Dateien mittels Paste und Drop-Files am laufen.
Code: Alles auswählen
procedure TMainWindow.actionPasteExecute(Sender: TObject);
var
Page: TImagePage;
{$ifdef WINDOWS}
ClipboardFileList: HDROP;
FileBuffer: PChar;
BufferSize: integer;
{$else}
ClipboardFileList: TStringArray;
FileBuffer: string;
{$endif}
IndexI: integer;
FilesToPaste: TStringArray;
begin
{$ifdef WINDOWS}
if (Clipboard.HasFormat(CF_HDROP) and OpenClipboard(0)) then begin
try
ClipboardFileList := GetClipboardData(CF_HDROP);
if ClipboardFileList <> 0 then begin
for IndexI := 0 to (DragQueryFile(ClipboardFileList, $FFFFFFFF, nil, 0) - 1) do begin
BufferSize := DragQueryFile(ClipboardFileList, IndexI, nil, 0);
FileBuffer := StrAlloc(BufferSize + 1);
try
if (DragQueryFile(ClipboardFileList, IndexI, FileBuffer, BufferSize + 1) > 0) then begin
SetLength(FilesToPaste, IndexI + 1);
FilesToPaste[IndexI] := FileBuffer;
end;
finally
StrDispose(FileBuffer);
end;
end;
end;
finally
CloseClipboard;
end;
end;
{$else}
if Clipboard.HasFormat(CF_Text) then begin
ClipboardFileList := Clipboard.AsText.Trim.Split(Chr($0A));
for IndexI := 0 to (Length(ClipboardFileList) - 1) do begin
FileBuffer := ParseURI(ClipboardFileList[IndexI]).Path + ParseURI(ClipboardFileList[IndexI]).Document;
if (IsRegular(FileBuffer)) then begin
SetLength(FilesToPaste, IndexI + 1);
FilesToPaste[IndexI] := FileBuffer;
end;
end;
end;
{$endif}
if (Length(FilesToPaste) > 0) then begin
Page := PageControl.ActivePage as TImagePage;
if (Assigned(Page)) then begin
Page.PasteFiles(FilesToPaste);
end;
end;
end;
procedure TMainWindow.FormDropFiles(Sender: TObject; const FileNames: array of string);
var
MousePoint: TPoint;
Page: TImagePage;
IndexI: integer;
FilesToPaste: TStringArray;
FileBuffer: string;
begin
Page := PageControl.ActivePage as TImagePage;
if (Assigned(Page)) then begin
MousePoint := Page.ScreenToControl(Mouse.CursorPos);
if Page.ClientRect.Contains(MousePoint) then begin
{$ifdef WINDOWS}
for IndexI := Low(FileNames) to High(FileNames) do begin
FileBuffer := FileNames[IndexI];
if not DirectoryExists(FileBuffer) then begin
SetLength(FilesToPaste, IndexI + 1);
FilesToPaste[IndexI] := FileBuffer;
end;
end;
{$else}
for IndexI := Low(FileNames) to High(FileNames) do begin
FileBuffer := FileNames[IndexI];
if (IsRegular(FileBuffer)) then begin
SetLength(FilesToPaste, IndexI + 1);
FilesToPaste[IndexI] := FileBuffer;
end;
end;
{$endif}
Page.PasteFiles(FilesToPaste);
end;
end;
end;
Code: Alles auswählen
procedure TImagePage.PasteFiles(const AFiles: TStringArray);
var
IndexI: integer;
FileToPaste: string;
UserNumber: integer;
PreserveTimeStamps: boolean;
ConvertTextFiles: boolean;
TextfileEndings: string;
IsTextFile: boolean;
begin
with TXMLSettings.Create(SettingsFile) do begin
try
OpenKey('Settings');
PreserveTimeStamps := GetValue('KeepTimestamps', True);
UserNumber := GetValue('DefaultUserNumber', 0);
ConvertTextFiles := GetValue('ConvertTextFiles', False);
TextfileEndings := GetValue('TextFileEndings', 'txt pip pas');
CloseKey;
finally
Free;
end;
end;
for IndexI := 0 to (Length(AFiles) - 1) do begin
FileToPaste := AFiles[IndexI];
IsTextFile := (ConvertTextFiles and TextFileEndings.Contains(RightStr(FileToPaste,
(Length(FileToPaste) - Pos('.', FileToPaste)))));
if (FileExists(FileToPaste)) then begin
FCpmTools.WriteFileToImage(FileToPaste, UserNumber, IsTextFile, PreserveTimeStamps);
end;
end;
RefreshDirectory;
end;
Code: Alles auswählen
procedure TCpmTools.WriteFileToImage(AFileName: string; AUserNumber: integer; AIsTextFile: boolean;
APreserveTimeStamps: boolean);
var
UnixFile: file of byte;
CpmFile: TCpmFile;
CpmName: string[15];
Inode: TCpmInode;
Buffer: array of byte = nil;
UnixFileSize: longword;
WriteError: boolean;
IndexJ: longword;
DataByte: byte;
Times: TUTimeBuf;
{$ifdef UNIX}
StatBuf: stat;
{$else}
FileAttr: TWIN32FILEATTRIBUTEDATA;
SystemTime, LocalTime: TSystemTime;
{$endif}
begin
try
AssignFile(UnixFile, AFileName);
Reset(UnixFile, 1);
UnixFileSize := FileSize(UnixFile);
except
on e: Exception do begin
MessageDlg(Format('can not open %s' + LineEnding + '%s', [ExtractFileName(AFileName), e.Message]),
mtError, [mbOK], 0);
exit;
end;
end;
CpmName := Format('%.2d%s', [AUserNumber, ExtractFileName(AFileName)]);
// check if file already exists
if (FCpmFileSystem.IsFileExisting(CpmName)) then begin
if (MessageDlg(Format('file %s already exists.' + LineEnding + 'replace existing file?',
[ExtractFileName(AFileName)]), mtError, [mbYes, mbNo], 0) = mrYes) then begin
if not (FCpmFileSystem.Delete(PChar(Format('%.2d%s', [AUserNumber, ExtractFileName(AFileName)])))) then begin
MessageDlg(Format('can not replace %s' + LineEnding + '%s',
[ExtractFileName(AFileName), FCpmFileSystem.GetErrorMsg]),
mtError, [mbOK], 0);
exit;
end;
end
else begin
exit;
end;
end;
if not (FCpmFileSystem.Create(FCpmFileSystem.GetDirectoryRoot, CpmName, UnixFileSize, Inode, &666)) then begin
MessageDlg(Format('can not create %s' + LineEnding + '%s', [ExtractFileName(AFileName), FCpmFileSystem.GetErrorMsg]),
mtError, [mbOK], 0);
exit;
end;
WriteError := False;
FCpmFileSystem.Open(Inode, CpmFile, O_WRONLY);
if (AIsTextFile) then begin
try
SetLength(Buffer, 4096);
except
on e: Exception do begin
MessageDlg(Format('can not create buffer space' + LineEnding + '%s', [e.Message]),
mtError, [mbOK], 0);
exit;
end;
end;
repeat
IndexJ := 0;
while ((IndexJ < (Length(Buffer) div 2)) and not EOF(UnixFile)) do begin
Read(UnixFile, DataByte);
if (DataByte = $0A) then begin
Buffer[IndexJ] := $0D;
Inc(IndexJ);
end;
Buffer[IndexJ] := DataByte;
Inc(IndexJ);
end;
if (EOF(UnixFile)) then begin
Buffer[IndexJ] := &032;
Inc(IndexJ);
end;
if (FCpmFileSystem.Write(CpmFile, @Buffer[0], IndexJ) <> IndexJ) then begin
MessageDlg(Format('can not write %s' + LineEnding + '%s',
[Format('%.d:%s', [AUserNumber, ExtractFileName(AFileName)]), FCpmFileSystem.GetErrorMsg]),
mtError, [mbOK], 0);
WriteError := True;
Break;
end;
until (EOF(UnixFile));
end
else begin
try
SetLength(Buffer, UnixFileSize);
except
on e: Exception do begin
MessageDlg(Format('can not create buffer space' + LineEnding + '%s', [e.Message]),
mtError, [mbOK], 0);
exit;
end;
end;
try
BlockRead(UnixFile, Buffer[0], UnixFileSize);
except
on e: Exception do begin
MessageDlg(Format('can not read %s from disk' + LineEnding + '%s', [ExtractFileName(AFileName), e.Message]),
mtError, [mbOK], 0);
exit;
end;
end;
if (FCpmFileSystem.Write(CpmFile, @Buffer[0], UnixFileSize) <> UnixFileSize) then begin
MessageDlg(Format('can not write %s' + LineEnding + '%s',
[Format('%.d:%s', [AUserNumber, ExtractFileName(AFileName)]), FCpmFileSystem.GetErrorMsg]),
mtError, [mbOK], 0);
WriteError := True;
end;
end;
if (not FCpmFileSystem.Close(CpmFile) and not WriteError) then begin
MessageDlg(Format('can not close %s' + LineEnding + '%s',
[Format('%.d:%s', [AUserNumber, ExtractFileName(AFileName)]), FCpmFileSystem.GetErrorMsg]), mtError, [mbOK], 0);
end;
if (APreserveTimeStamps and not WriteError) then begin
{$ifdef UNIX}
FpStat(AFileName, StatBuf);
Times.AcTime := FileDateToDateTime(StatBuf.st_atime);
Times.ModTime := FileDateToDateTime(StatBuf.st_mtime);
{$else}
GetFileAttributesEx(PChar(AFileName), GetFileExInfoStandard, @FileAttr);
FileTimeToSystemTime(FileAttr.ftLastAccessTime, SystemTime);
SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime);
Times.AcTime := SystemTimeToDateTime(LocalTime);
FileTimeToSystemTime(FileAttr.ftLastWriteTime, SystemTime);
SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime);
Times.ModTime := SystemTimeToDateTime(LocalTime);
{$endif}
FCpmFileSystem.UpdateTime(Inode, Times);
end;
try
CloseFile(UnixFile);
except
on e: Exception do begin
MessageDlg(Format('can not close %s' + LineEnding + '%s', [ExtractFileName(AFileName), e.Message]),
mtError, [mbOK], 0);
end;
end;
if not FCpmFileSystem.Sync then begin
MessageDlg(Format('paste error write back directory' + LineEnding + '%s', [FCpmFileSystem.GetErrorMsg]),
mtError, [mbOK], 0);
end;
end;
Gibt es eine Möglichkeit dieses Array als z.B. Custom-Data über das Clipboard direkt mit Paste (CTRL-V) bzw. Drop z.B. im Windows Explorer oder Linux Dolphin dann zu speichern. Das ganze soll, wie auch schon das Hineinkopieren von Dateien, Cross-Platform (Linux , Windows) funktionieren.
Freue mich auf Tips von euch.
Grüße
HobbyProgrammer
Verein
Links
