[Lazarus-es] problema con Unicode y CreateFileW
islanis en infomed.sld.cu
islanis en infomed.sld.cu
Mar Oct 14 21:27:25 CEST 2014
OK, para que no quede mas dudas acá envío el archivo
SCWideUnbufferedCopier.pas,que es donde se encuentra todo lo que me
pides si aún tienes mas dudas pues me preguntas o quedamos y te envío
la fuente del proyecto completo si por aca podemos resolver el
problema pues para alante, que espero que si.
Saludos Ale
//--------------------------SCWideUnbufferedCopier.pas-------------------
{
This file is part of SuperCopier.
SuperCopier is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
SuperCopier is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
}
unit SCWideUnbufferedCopier;
{$MODE Delphi}
interface
uses
Windows,Messages,SCCopier, lclproc, Dialogs;
const
MAX_WAITING_IO=16; // nombre max d'I/O en attente
READ_ENDING_EVENT=0;
WRITE_ENDING_EVENT=1;
WORK_EVENT=2;
READ_ENDING_EVENT_NAME='SC2 Read ending';
WRITE_ENDING_EVENT_NAME='SC2 Write ending';
WORK_EVENT_NAME='SC2 Work';
ENABLE_32K_CHARS_PATH='\\?\';
type
TWideUnbufferedCopier=class(TCopier)
private
SrcOvr,DestOvr:TOverlapped;
Events:array[0..2] of THandle;
Buffer:PByte;
FullBufferSize:Cardinal;
protected
procedure SetBufferSize(Value:cardinal);override;
public
constructor Create;
destructor Destroy;override;
function DoCopy:Boolean;override;
end;
implementation
uses SCCommon,SCLocStrings,SCWin32,SysUtils,Math;
//******************************************************************************
//******************************************************************************
//******************************************************************************
// TWideUnbufferedCopier: descendant de TCopier, copie non
bufferisйe asynchrone
// gйrant l'unicode
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
// Create
//******************************************************************************
constructor TWideUnbufferedCopier.Create;
// MakeUnique: ajoute un identifiant unique de Copier а S
function MakeUnique(S:String):String;
begin
Result:=S+IntToStr(Cardinal(Self));
end;
begin
inherited;
FBufferSize:=0;
// crйer les йvиnements pour le copier
Events[READ_ENDING_EVENT]:=Windows.CreateEvent(nil,True,False,PChar(MakeUnique(READ_ENDING_EVENT_NAME)));
Events[WRITE_ENDING_EVENT]:=Windows.CreateEvent(nil,True,False,PChar(MakeUnique(WRITE_ENDING_EVENT_NAME)));
Events[WORK_EVENT]:=Windows.CreateEvent(nil,True,False,PChar(MakeUnique(WORK_EVENT_NAME)));
if (Events[READ_ENDING_EVENT]=INVALID_HANDLE_VALUE) or
(Events[WRITE_ENDING_EVENT]=INVALID_HANDLE_VALUE) or
(Events[WORK_EVENT]=INVALID_HANDLE_VALUE) then
begin
raise Exception.Create('Failed to create copy events');
end;
// associer les йvиnements aux structures Overlapped
SrcOvr.hEvent:=Events[READ_ENDING_EVENT];
DestOvr.hEvent:=Events[WRITE_ENDING_EVENT];
end;
//******************************************************************************
// Destroy
//******************************************************************************
destructor TWideUnbufferedCopier.Destroy;
begin
SetBufferSize(0);
// dйtruire les йvиnements
FileClose(Events[READ_ENDING_EVENT]); { *Converted from CloseHandle* }
FileClose(Events[WRITE_ENDING_EVENT]); { *Converted from CloseHandle* }
FileClose(Events[WORK_EVENT]); { *Converted from CloseHandle* }
inherited;
end;
//******************************************************************************
// SetBufferSize: fixe la taille du buffer de copie
//******************************************************************************
procedure TWideUnbufferedCopier.SetBufferSize(Value:cardinal);
begin
if Value<>FBufferSize then
begin
FBufferSize:=Value;
FullBufferSize:=FBufferSize*MAX_WAITING_IO;
VirtualFree(Buffer,0,MEM_RELEASE); // on libиre le
prйcйdent buffer allouй
Buffer:=VirtualAlloc(nil,FullBufferSize,MEM_COMMIT,PAGE_READWRITE);
end;
end;
//******************************************************************************
// DoCopy: renvoie false si la copie йchoue
//******************************************************************************
function TWideUnbufferedCopier.DoCopy:boolean;
function OnlyFullChunks(Size:Int64):Int64;
begin
Result:=Size-Size mod FBufferSize;
end;
var HSrc,HDest,HBufferedDest:THandle;
SourceFile,DestFile:WideString;
ReadPending,WritePending,ReadEnd,WriteEnd:Boolean;
BytesProcessed,UsedBuffer:Cardinal;
Ok,ContinueCopy:Boolean;
ReadPos,WritePos:Int64;
ReadPosRec:Int64Rec absolute ReadPos;
WritePosRec:Int64Rec absolute WritePos;
LastError:Cardinal;
SourceIsNetwork,DestIsNetwork:Boolean;
begin
Assert(Assigned(OnCopyProgress),'OnCopyProgress not assigned');
Result:=True;
with CurrentCopy do
begin
ContinueCopy:=True;
CopiedSize:=0;
SkippedSize:=0;
UsedBuffer:=0;
ReadPending:=False;
WritePending:=False;
ReadEnd:=False;
WriteEnd:=False;
ReadPos:=0;
WritePos:=0;
SourceFile:=FileItem.SrcFullName;
DestFile:=FileItem.DestFullName;
SourceIsNetwork:=PathIsNetworkPath(PWideChar(SourceFile));
DestIsNetwork:=PathIsNetworkPath(PWideChar(DestFile));
// gйrer les chemins de plus de MAX_PATH caractиres
if not PathIsUNC(PWideChar(SourceFile)) then
SourceFile:=ENABLE_32K_CHARS_PATH+SourceFile;
if not PathIsUNC(PWideChar(DestFile)) then
DestFile:=ENABLE_32K_CHARS_PATH+DestFile;
Inc(FileItem.CopyTryCount);
try
HSrc:=INVALID_HANDLE_VALUE;
HDest:=INVALID_HANDLE_VALUE;
HBufferedDest:=INVALID_HANDLE_VALUE;
try
// on ouvre le fichier source
//ShowMessage(UTF8Decode(SourceFile));
HSrc:=Windows.CreateFileW(PWideChar(UTF8Decode(SourceFile)),
GENERIC_READ,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED
or
IfThen(SourceIsNetwork,0,FILE_FLAG_NO_BUFFERING),
0);
RaiseCopyErrorIfNot(HSrc<>INVALID_HANDLE_VALUE);
// effacer les attributs du fichier de destination pour
pouvoir l'ouvrir en йcriture
FileItem.DestClearAttributes;
// on ouvre le fichier de destination
if NextAction<>cpaRetry then // doit-on reprendre le transfert?
begin
HDest:=CreateFileW(PWideChar(UTF8Decode(DestFile)),
GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED
or
IfThen(DestIsNetwork,0,FILE_FLAG_NO_BUFFERING),
0);
RaiseCopyErrorIfNot(HDest<>INVALID_HANDLE_VALUE);
// on ouvre un handle sur le fichier de destination en
bufferisй pour pouvoir
// fixer le fichier а la bonne taille (en non
bufferisй, on ne peut copier
// que des blocs de taille multiple de celle d'une page
mйmoire)
HBufferedDest:=CreateFileW(PWideChar(UTF8Decode(DestFile)),
GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL,
0);
RaiseCopyErrorIfNot(HBufferedDest<>INVALID_HANDLE_VALUE);
end
else
begin
HDest:=CreateFileW(PWideChar(UTF8Decode(DestFile)),
GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_ALWAYS,
FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED,
0);
RaiseCopyErrorIfNot(HDest<>INVALID_HANDLE_VALUE);
HBufferedDest:=CreateFileW(PWideChar(UTF8Decode(DestFile)),
GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_ALWAYS,
FILE_ATTRIBUTE_NORMAL,
0);
RaiseCopyErrorIfNot(HBufferedDest<>INVALID_HANDLE_VALUE);
SkippedSize:=OnlyFullChunks(FileItem.DestSize);
Self.SkippedSize:=Self.SkippedSize+SkippedSize;
end;
// on aggrandit fichier de destination a au moins sa taille finale
// (pour йviter la fragmentation et pour que
l'overlapped fonctionne correctement)
RaiseCopyErrorIfNot(SetFileSize(HDest,OnlyFullChunks(FileItem.SrcSize)+FBufferSize));
// on amorce le systиme
ReadPos:=SkippedSize;
WritePos:=SkippedSize;
SetEvent(Events[WORK_EVENT]);
if FileItem.SrcSize>0 then // aucun traitemeant a faire pour
les fichiers vides
begin
while not (ReadEnd and WriteEnd) and ContinueCopy do
begin
// on attends qu'un йvиnement se produise
case
WaitForMultipleObjects(Length(Events), en Events[0],False,INFINITE) of
WAIT_OBJECT_0+READ_ENDING_EVENT:
begin
ResetEvent(Events[READ_ENDING_EVENT]);
ReadPending:=False;
RaiseCopyErrorIfNot(GetOverlappedResult(HSrc,SrcOvr,BytesProcessed,True));
ReadPos:=ReadPos+BytesProcessed;
UsedBuffer:=UsedBuffer+BytesProcessed;
ReadEnd:=ReadPos>=FileItem.SrcSize;
// on lance la lecture suivante
SetEvent(Events[WORK_EVENT]);
end;
WAIT_OBJECT_0+WRITE_ENDING_EVENT:
begin
ResetEvent(Events[WRITE_ENDING_EVENT]);
WritePending:=False;
RaiseCopyErrorIfNot(GetOverlappedResult(HDest,DestOvr,BytesProcessed,True));
WritePos:=WritePos+BytesProcessed;
UsedBuffer:=UsedBuffer-BytesProcessed;
WriteEnd:=WritePos>=FileItem.SrcSize;
// on lance l'йcriture suivante
SetEvent(Events[WORK_EVENT]);
// des donnйes ont йtйs
йcrites -> on dйclenche l'evenement de progression
// ne pas compter le dйpassement de la taille
du fichier
if WriteEnd then
BytesProcessed:=BytesProcessed-(WritePos-FileItem.SrcSize);
CopiedSize:=CopiedSize+BytesProcessed;
Self.CopiedSize:=Self.CopiedSize+BytesProcessed;
ContinueCopy:=OnCopyProgress;
end;
WAIT_OBJECT_0+WORK_EVENT:
begin
ResetEvent(Events[WORK_EVENT]);
// on lance une lecture si il n'y en a pas en cours
et si le buffer n'est pas plein
if not ReadEnd and not ReadPending and
(FullBufferSize-UsedBuffer>=FBufferSize) then
begin
SrcOvr.Offset:=ReadPosRec.Lo;
SrcOvr.OffsetHigh:=ReadPosRec.Hi;
// on vйrifie que l'on est pas en buffer overflow
if (Abs((WritePos-ReadPos) mod
FullBufferSize)>FBufferSize) or not WritePending then
begin
Ok := Windows.ReadFile(HSrc,
Pointer(Cardinal(Buffer)+SrcOvr.Offset mod FullBufferSize)^,
FBufferSize, BytesProcessed, @SrcOvr);
ReadPending:=GetLastError=ERROR_IO_PENDING;
RaiseCopyErrorIfNot(Ok or ReadPending);
if not ReadPending then
SetEvent(Events[READ_ENDING_EVENT]); // si l'i/o est synchrone, on
dйclenche l'evenement a la main
end;
end;
// on lance une йcriture si il n'y en a pas en
cours et si il y a au moins un bloc de lu
if not WriteEnd and not WritePending and
((UsedBuffer>=FBufferSize) or ReadEnd) then
begin
DestOvr.Offset:=WritePosRec.Lo;
DestOvr.OffsetHigh:=WritePosRec.Hi;
// on vйrifie que l'on est pas en buffer overflow
if (Abs((WritePos-ReadPos) mod
FullBufferSize)>FBufferSize) or not ReadPending then
begin
Ok:=WriteFile(HDest,Pointer(Cardinal(Buffer)+DestOvr.Offset mod
FullBufferSize)^,FBufferSize,BytesProcessed, en DestOvr);
WritePending:=GetLastError=ERROR_IO_PENDING;
RaiseCopyErrorIfNot(Ok or WritePending);
if not WritePending then
SetEvent(Events[WRITE_ENDING_EVENT]); // si l'i/o est synchrone, on
dйclenche l'evenement a la main
end;
end;
end;
end;
end;
end;
// on fixe le fichier а la bonne taille en utilisant le
handle bufferisй
RaiseCopyErrorIfNot(SetFileSize(HBufferedDest,FileItem.SrcSize));
// copie de la date de modif
CopyFileAge(HSrc,HDest);
CopyFileAge(HSrc,HBufferedDest);
finally
LastError:=GetLastError;
// on dйclare la position courrante dans le fichier
destination comme fin de fichier
SetFileSize(HBufferedDest,CopiedSize+SkippedSize); //TODO:
ajouter gestion des erreurs !!!
// fermeture des handles si ouverts
FileClose(HSrc); { *Converted from CloseHandle* }
FileClose(HDest); { *Converted from CloseHandle* }
FileClose(HBufferedDest); { *Converted from CloseHandle* }
SetLastError(LastError); // ne pas polluer le code d'erreur
NextAction:=cpaNextFile;
end;
except
on E:ECopyError do
begin
dbgln(GetLastError);
Result:=False;
CopyError;
end;
end;
end;
end;
end.
//---------------------------------------------------------------------------
José Mejuto <joshyfun en gmail.com> escribió:
> El 14/10/2014 a las #4, J.Alejandro Martinez Linares escribió:
>> Hola estoy tratando de reparar una versión de supercopier que es un
>> programa para copiar archivos y carpetas pero justo en la seccion que
>> les pongo abajo cada vez que el sitema se encuentra una carpeta con
>> tildes el sistema me da una excepción notificandome que no tiene acceso,
>> y justo en el fragmento que les muestro es donde el sistema se engancha
>
> Hola,
>
> Deberías de mostrar también de donde sacas SourceFile, si es un
> ansistring, un utf8string o qué.
>
> --
>
>
> _______________________________________________
> Lazarus-es mailing list
> Lazarus-es en lists.lazarus.freepascal.org
> http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus-es
>
----------------------------------------------------------------
This message was sent using IMP, the Internet Messaging Program.
--
Nunca digas nunca, di mejor: gracias, permiso, disculpe.
Este mensaje le ha llegado mediante el servicio de correo electronico que ofrece Infomed para respaldar el cumplimiento de las misiones del Sistema Nacional de Salud. La persona que envia este correo asume el compromiso de usar el servicio a tales fines y cumplir con las regulaciones establecidas
Infomed: http://www.sld.cu/
More information about the Lazarus-es
mailing list