|
Antwort |
|
Registriert seit: 12. Jun 2003 107 Beiträge Delphi 7 Enterprise |
#1
Code:
So da haste fast alles (könnte was übersehen haben den ganzen Code-Teil). Da ich bis jetzt noch keine Lösung habe (Du weißt sie vermutlich auch nicht) und da es sich z.Z. nur um eine Datei handelt, ignoriere ich das.
type
PDateiRec = ^TDateiRec; TDateiRec = packed record _DateiName : WideString; _FileName : TFileName; _Erw0 : TFileName; _Erw1 : TFileName; _Pfad : string; _Time : TDateTime; _Attr : integer; _Size : int64; _CRC64Calc : int64; end; const cUnicodeStr = ['?']; C_P = '.'; C_PP = '..'; //------------------------------------------------------------------------------ function _StringToWideString(const S: AnsiString): WideString; var X : integer; CodePage : word; begin CodePage := CP_ACP; if S = '' then Result := '' else begin X := MultiByteToWideChar(codePage, MB_PRECOMPOSED, PChar(@S[1]), - 1, nil, 0); SetLength(result, X - 1); if X > 1 then MultiByteToWideChar(CodePage, MB_PRECOMPOSED, PChar(@S[1]),- 1, PWideChar(@Result[1]), X - 1); end; end; //------------------------------------------------------------------------------ function _WideStringToString(const WS: WideString): AnsiString; var X : integer; CodePage : word; begin CodePage := CP_ACP; {CP_ACP ANSI code page CP_MACCP Macintosh code page CP_OEMCP OEM code page} if WS = '' then result := '' else begin X := WideCharToMultiByte(codePage,WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR, @WS[1], - 1, nil, 0, nil, nil); SetLength(result, X - 1); if X > 1 then WideCharToMultiByte(codePage, WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or WC_DEFAULTCHAR,@WS[1], - 1, @result[1], X - 1, nil, nil); end; end; { WideStringToString } //------------------------------------------------------------------------------ function _ReNameFile(const FromFile,ToFile:string;AHandle:THandle=0):boolean; begin result := _ShellFileOperation(FromFile,ToFile,FO_RENAME,FOF_NOCONFIRMATION or FOF_SILENT); if not result and (AHandle <> 0) then SendMessage(AHandle,WM_SYSTEM_DATEI,longInt(@FromFile),14); end; //------------------------------------------------------------------------------ {Proceduren/Functionen-Anfang**************************************************} {Damit können wir also die Dateien "windowsgemäß" löschen, die "fFlags" können folgendes sein: - FOF_ALLOWUNDO = läßt ein Rückgängigmachen, falls möglich zu - FOF_NOWCONFIRMATION = Löschen ohne Bestätigungsfrage - FOF_SIMPLEPROGRESS = mit Fortschritts-Dialogbox, allerdings ohne die Dateinamen anzuzeigen _ FOF_SILENT = ohne Fortschritts-Dialogbox Mehrere Flags können mit OR kombiniert werden.} //------------------------------------------------------------------------------ function _ShellFileOperation(const FromFile,ToFile: string; const Func,Flags: integer;AHandle:THandle=0):boolean; var //uses Forms,ShellAPI SHFileOpStruct: TSHFileOpStruct; begin Application.ProcessMessages; with SHFileOpStruct do begin Wnd := Application.Handle; wFunc := Func; fFlags := Flags;// or FOF_NOERRORUI; //keine Fehlermeldung pFrom := PChar(_ExBackSlash(FromFile)+#0+#0); hNameMappings := nil; lpszProgressTitle := nil; if ToFile = '' then pTo := nil else pTo := PChar(ToFile+#0+#0); // if ToFile = pFrom then exit; // if pFrom ='' then exit; end; result := SHFileOperation(SHFileOpStruct) = 0; if not result then SendMessage(AHandle,WM_SYSTEM_DATEI,longInt(@FromFile),15); Application.ProcessMessages; end; //------------------------------------------------------------------------------ procedure TDrive.GetFiles(APfad,AMaske:string); var SR : TSearchRec; HFind : THandle; Directory : string; SRW : WIN32_FIND_DATAW; X :String; begin // X := 'C:\Temp\Test\*.*'; Directory:= ExtractFilePath(APfad); try HFind:=FindFirstFileW(PWideChar(_StringToWideString(APfad+AMaske)),SRW); if HFind<>INVALID_HANDLE_VALUE then begin repeat if SRW.dwFileAttributes and faDirectory <> faDirectory then FilesAdd(DateiRecList,Directory,SRW); until FindNextFileW(HFind,SRW) <> true; end; except end; if not AMitDir then exit; try try if FindFirst(Directory + '*.*',AAttrDir ,SR) = 0 then begin repeat if ((SR.Attr and faDirectory) = faDirectory) and ((SR.Name[1] <> C_P) and (SR.Name[1] <> C_PP)) then begin SendMessage(Handle,WM_READ_PFAD,0,DateiRecList.Count); GetFiles(Directory+_BackSlash(SR.Name)+ExtractFileName(APfad),AMaske); end; until FindNext(SR) <> 0; end; except end; finally SysUtils.FindClose(SR); end; end; //------------------------------------------------------------------------------ function _UniCodeErkennen(var Value: string;Ch :TChOfSet):boolean; var I: integer; begin Result := false; for I:=1 to length(Value) do if Value[I] in Ch then begin Value[I] := '_'; Result := true; end; end; //------------------------------------------------------------------------------ procedure TDrive.ClearRec(P:pointer); begin with PDateiRec(P)^ do begin _DateiName :=#0; _FileName := ''; _Erw0 := ''; _Erw1 := ''; _Pfad := ''; _Time := 0; _Attr := 0; _Size := 0; _CRC64Calc := 0; end; end; //------------------------------------------------------------------------------ procedure TDrive.FilesAdd(TL:TList;Directory:string;SRW : WIN32_FIND_DATAW); var//uses SysUtils,_Strings; P : pointer; FromFile : string; ToFile : string; begin with SRW do begin P := new(PDateiRec); with PDateiRec(P)^,SRW do begin //_StringToWideString ClearRec(P); if dwFileAttributes and faDirectory <> faDirectory then _DateiName := cFileName; ToFile := _WideStringToString(_DateiName); _Pfad := Directory; if _UniCodeErkennen(ToFile,cUnicodeStr) then begin {$I+} // Dispose(P); {$I-} // exit; //Noch keine Lösung für das Problem FromFile := _Pfad+_WideStringToString(_DateiName); ToFile := _Pfad+ToFile; _ReNameFile(FromFile,ToFile) end; _FileName := _WideStringToString(_DateiName); _Erw0 := _ExtractFileExtOhnePunkt(_FileName); _Erw1 := ExtractFileExt(_FileName); _FileName := ChangeFileExt(_FileName,''); _Pfad := Directory; _Time := _FileTimeToDateTime(ftCreationTime);//TFileTime _Attr := dwFileAttributes; _Size := nFileSizeHigh shl 32 or nFileSizeLow; end; end; TL.Add(P); end; Es ärgert mich allerdings sehr, weil es NICHT RICHTIG IST was zu ignorieren. Bin für jeden Vorschlag dankbar aber ich denke das ich hier (verständlich ist nicht häufig der Fehler), keine Lösung finden werde. Das Problem für mich ist das ich leider kein Englisch/Russisch kann, dann hätte ich vermutlich schon eine Lösung. Nur als Hintergrund wissen: Soll ein Privates Programm werden das (ich habe viele Hefte und Bücher als PDF) und ich möchte sie, nach meinem Schema verwalten. Und weil jeder seien eigen „Müll“ in die Dateinamen schreibt, ich den nicht will und ich ein bisschen Proggen kann, will ich mir das Problem weitergehend automatisch vom Halse schaffen. (Gut in der Zeit könnte ich die Dateinamen auch mit der Hand ändern. Macht aber nicht soviel Spaß. Und doppelte Dateien zu finden ist auch nicht so einfach (per hand), nicht wenn man mehr als 5.000 Bücher auf den Rechner hat. Ich habe die meisten davon schon gelesen (sogar gekauft) aber das ist eine andere Geschichte,... Zufrieden? Alle Fragen geklärt? Mfg |
Zitat |
Ansicht |
Zur Linear-Darstellung wechseln |
Hybrid-Darstellung |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |