Hola,tengo este código:
Código Delphi
[-]
procedure FindFiles(StartDir, FileMask: string; recursively: boolean; var FilesList: TStringList);
const
MASK_ALL_FILES = '*.*';
CHAR_POINT = '.';
var
SR: TSearchRec;
DirList: TStringList;
IsFound: Boolean;
i: integer;
ext: string;
begin
if (StartDir[length(StartDir)] <> '\') then begin
StartDir := StartDir + '\';
end;
IsFound := FindFirst(StartDir + FileMask, faAnyFile - faDirectory, SR) = 0;
while IsFound do begin
ext:= AnsiLowercase(copy(SR.Name,length(SR.Name)-2,3));
if (ext = 'jpg') or (ext = 'bmp') then
begin
FilesList.Add(StartDir + SR.Name);
end;
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
if (recursively) then begin
DirList := TStringList.Create;
try
IsFound := FindFirst(StartDir + MASK_ALL_FILES, faAnyFile, SR) = 0;
while IsFound do
begin
if ((SR.Attr and faDirectory) <> 0) and
(SR.Name[1] <> CHAR_POINT) then
DirList.Add(StartDir + SR.Name);
IsFound := FindNext(SR) = 0;
end;
FindClose(SR);
for i := 0 to DirList.Count - 1 do
FindFiles(DirList[i], FileMask, recursively, FilesList);
finally
DirList.Free;
end;
end;
end;
procedure TForm1.WMDEVICECHANGE(var Msg: TMessage);
var
Letra: Char;
n:integer;
SR: TSearchRec;
j,k:integer;
nombre_fichero,ext:String;
StartDir, FileMask: string;
DirList: TStringList;
IsFound: Boolean;
imjpg : TJPEGImage;
imbmp : TBitmap;
pos:Pchar;
nombre:String;
const CHAR_POINT = '.';
begin
if Msg.WParam = DBT_DEVICEARRIVAL then
begin
for Letra:= 'C' to 'Z' do
begin
if (GetDriveType(Pchar(Letra+':\')) = DRIVE_REMOVABLE) or (GetDriveType(Pchar(Letra+':\')) = DRIVE_CDROM) then
begin
FindFiles(Letra+':\','*.*',true,lista_archivos);
for j:=0 to lista_archivos.Count-1 do
begin
for k:=0 to lista_aux.Count-1 do
begin
ext:= AnsiLowercase(copy(lista_archivos.Strings[j],length(lista_archivos.Strings[j])-2,3));
if (ext='bmp') then
begin
pos:=StrRScan(lista_archivos.FieldAddress(lista_archivos.Strings[j]),'\');
pos:=pos+1;
while(pos <'p') do
begin
nombre:=copy(pos,length(pos),1);
pos:=pos+1;
end;
if pos='p' then
begin
nombre:=copy(pos,length(pos),1);
end;
imbmp := TBitmap.Create;
Width := imjpg.Width;
Height := imjpg.Height;
Canvas.Draw(0,0,imjpg);
imbmp.LoadFromFile(nombre);
imbmp.SaveToFile('C:\FOTOS\'+nombre);
Free;
end
else if(ext='jpg') then
begin
pos:=StrRScan(lista_archivos.FieldAddress(lista_archivos.Strings[j]),'\');
pos:=pos+1;
while(pos<'j') do
begin
nombre:=copy(pos,length(pos),1);
pos:=pos+1;
end;
if pos='j' then
begin
imbmp := TBitmap.Create;
Width := imjpg.Width;
Height := imjpg.Height;
Canvas.Draw(0,0,imjpg);
imbmp.LoadFromFile(nombre+'bmp');
imbmp.SaveToFile('C:\FOTOS\'+nombre);
Free;
end;
end;
end;
FindFiles('C:\FOTOS\','*.*',true,lista_archivos);
Memo1.Lines.Assign(lista_archivos);
Memo1.Update;
if Memo1.Lines.Count>0 then
begin
i:=0;
RellenarFotos(i);
cantidades.Clear;
for n:=0 to Memo1.Lines.Count-1 do
begin
cantidades.Add('0');
end;
end;
end;
end;
end;
inherited;
end;
Pues bien,lo que pasa es que no guarda las fotos bmp y tampoco las
convertidas a bmp, en la carpeta c:\fotos, y tampoco sale en el Memo1,
la ruta del directorio fotos,con los archivos metidos.No sé si me habré equivocado al mover posiciones de lista_archivos.Strings[j].No me queda muy
claro el cómo hacer una vez que encuentres una posicion que quieres,coger
esa y las que correspondan.Por ejemplo:Busco hasta encontrar el último '\',
si lo encuentro salto a la sgte posicion que sería la 1ª letra del nombre fichero.DE esa letra,coger esa hasta el cararcter '.'.Cogería el nombre del archivo más el '.', y despues de éste caracter pondría bmp,si lo que quiero es pasra de jpg a bmp.
Espero,que me podáis decir qué está mal.
Saludos.