loadfile aus TMemoryStream

[busybyte]

//EDIT

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  ExtCtrls,JPEG;

type

  TSkindatei=Record
  skSize,skPosition:integer;
  skFilename:String;
  skPic:TPicture;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
   Procedure Streamini;
   Procedure Streamfree;
   { Private declarations }
  public
  SkinDateien:Array of TSkinDatei;
  ErrorCode:integer;
//  function AddSkindatei(Var DList:TStringList;SkinDatei_:TSkindatei):Boolean;
//  function LoadPicture(aFileName:String):Boolean;
  Function AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
  procedure LoadMemory;
  procedure FindFiles(Var DList_:TStringList);
//  procedure CreateBackGround(Filename_:String;Skinwidth,Skinheight:integer;Owner_:TWinControl);
  procedure CreateBackGround(Dateiindex_:integer;Skinwidth,Skinheight:integer;Owner_:TWinControl);
  procedure resetDatas(Var DList_:TStringList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Var
lFile :TMemoryStream;     //Gesamtstream aller Files
pFile :TMemoryStream;     //Stream EinzelFile 
AnzSkinDateien:Longint;
Search :Boolean;
SkinPfad:String;
TestS:String;
Testi1:integer;
TempJpeg :TBitmap;
Extensions:TStringList;
Imgcnt:integer;
var StrtTick,Tick:Cardinal;
const
   FileFilter = '*.bmp;*.jpg;*.jpeg;*.png;|'+
     '*.bmp;*.jpg;*.jpeg;';


Procedure TForm1.CreateBackGround(Dateiindex_:integer;Skinwidth,Skinheight:integer;Owner_:TWinControl);
Var ex_:String;     TempJpeg:TJpegImage;
L1:integer;
TmpImg:TImage;
begin
    with SkinDateien[Dateiindex_] do
    begin
        skPic:=TPicture.Create;
     try
      skPic.RegisterFileFormat('jpg;*.bmp; *.jpeg;*.bmp','JPEG',TBitmap);
      ex_:=Lowercase(ExtractFileExt(skFilename));
      skPic.Bitmap.Width:=SkinWidth;
      skPic.Bitmap.Height:=SkinHeight;

       if (Ex_ = '.jpg') or (Ex_='jpeg') then
          begin
          TempJpeg := TJPEGImage.Create;
          lfile.Position:=skPosition;
          TempJpeg.LoadFromStream(lFile);
          skPic.Bitmap.Assign(TempJpeg);
          TempJpeg.Free;
          end
          else
           if (Ex_ = '.png') then
            begin
             { TempPng := TPNGObject.Create;
              TempPng.LoadFromStream(pFile);
              Picture.Bitmap.Assign(TempJpeg);
              TempPng.Free;
              }
            end
           else
           if (Ex_='.bmp') then
            begin
            lfile.Position:=skPosition;
            skPic.Bitmap.LoadFromStream(lFile);
            end;
   except showmessage('Dateiindex: '+inttostr(Dateiindex_));end;
  end;
end;



procedure TForm1.LoadMemory;
var DList:TStringList;
    lCount: Integer;
begin
DList := TStringList.Create;      //Hilfsliste
  try
  resetDatas(DList);
  Search := True;
  AnzSkinDateien:=0;
  SetLength(SkinDateien,AnzSkinDateien);
  FindFiles(DList);      //Dateien finden und in Stringlist
  //zu Testzwecken um zu sehen ob bis hier alles klappt:
  Memo1.Lines.Assign(DList);                                          //<---Bremse !!!
  finally DList.Free; end;
end;


Function TForm1.AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
Var L1:integer;
begin
//Setlength verbraucht viel zeit deswegen gleich ein paar mehr
while AnzSkinDateien>Length(SkinDateien)-1 do
Setlength(SkinDateien,AnzSkinDateien+100);
Skindateien[AnzSkinDateien]:=SkinDatei_;
inc(AnzSkinDateien);
DList_.Add(SkinDatei_.skFilename);
end;


procedure TForm1.FindFiles(Var DList_:TStringList);
Var TmpSkinDatei:TSkinDatei;
S:String;

  procedure DoSearch(const Path:String);
  var SR : TSearchRec;
  begin

    If Findfirst(Path + '*.*',faAnyFile,SR) = 0 then
     try
       repeat
         if GetTickCount >= Tick then
         begin
           Tick:= GetTickCount +100;
           Application.ProcessMessages;
         end;

         If (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
           DoSearch(Path + SR.Name + '\')

         else
          if Extensions.IndexOf(ExtractFileExt(SR.Name)) >= 0 then
            with TmpSkinDatei do
             begin
             S:=Path + SR.Name;
             pFile.Clear;
             pFile.LoadFromFile(S);
             skSize:=pFile.Size;
              while (Length(SkinDateien)>200) or (lfile.size>160000000) do
               begin
               ErrorCode:=1;
               exit;
               end;

             skPosition:=lFile.Position;
             skFilename:=S;
             AddSkindatei(DList_,TmpSkinDatei);
             pFile.Position := 0;
             lFile.CopyFrom(pFile,pFile.Size);
             end;

        until FindNext(SR) <> 0;
     finally
       FindClose(SR);
     end;
    end;

begin
    try
     Tick := GetTickCount + 100;
     AnzSkinDateien:=0;
     lFile.Position:=0;
     pFile.Position:=0;
     resetDatas(DList_);
     DOSearch(SkinPfad);
     Setlength(SkinDateien,AnzSkinDateien); //Tatsächliche Länge setzen
    except Setlength(SkinDateien,0);
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
Var Filename_:String;
cnt1,L1:integer;
begin
with Opendialog1 do
begin
Filter:=FileFilter;
  if execute then
    begin
    Filename_:=Filename;
    SkinPfad:=  extractfilepath(Filename_);
    Label1.Caption:='';
    StrtTick:=Gettickcount;
    LoadMemory;    //Dateien suchen und in Hauptstream laden
    Label1.Caption:=inttostr(Length(SkinDateien))+ ' Bilder';
    Label2.Caption:=inttostr(lfile.Size div 1000000)+' MB' ;
    Label3.Caption:='in ' +inttostr((Tick-StrtTick) div 1000 )+' Sek.' ;
    end;
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
Var L1,cnt1_:integer;
  cnt1: Integer;
begin
L1:=Length(SkinDateien);

StrtTick:=Gettickcount;
imgCnt:=0;
for cnt1 := 0 to L1- 1 do
begin
 //Zeitmessung und Antifreeze;
  if GetTickCount >= Tick then
     begin
     Tick:= GetTickCount +100;
     Application.ProcessMessages;
     end;

//Alle Bilder in skPic
CreateBackGround(cnt1,100,100,Form1);

  //Alle skPic in Image1
 with SkinDateien[cnt1] do
  begin
  Image1.Picture.Bitmap.Assign(skPic.Bitmap);
  inc(imgCnt);
  end;

end;
Label4.Caption:= inttostr(imgcnt)+' Bilder';
showmessage('Erfolgreich: '+Label4.Caption);
Label5.Caption:='in ' +inttostr((Tick-StrtTick) div 1000 )+' Sek.' ;
end;


procedure TForm1.resetDatas(Var DList_:TStringList);
begin
DList_.Clear;
Memo1.Clear;
lFile.Clear;
pFile.Clear;
end;

Procedure TForm1.Streamini;
begin
lFile := TMemoryStream.Create();     //Gesamtstream aller Files
pFile := TMemoryStream.Create();     //Stream EinzelFile
SkinPfad:='C:\Windows\';
Extensions:=TStringList.Create;
  with Extensions do
    try
    Add('.bmp');
    Add('.jpg');
    Add('.jpeg');
    Add('.png');
    except   Extensions.Free; end;

    with Memo1 do
    begin
    Clear;
    Align:=alRight;
    ScrollBars:=ssBoth;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ErrorCode:=0;
Streamini;
end;

Procedure TForm1.Streamfree;
begin
  Setlength(Skindateien,0);
  freeandnil(lFile);
  freeandnil(pFile);
  freeandnil(Extensions);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Streamfree;
end;


end.

Man sieht jetzt ganz deutlich 2 Schwachstellen,
1. Wenn viele Unterverzeichnisse dursucht werden müssen
und
2. das Anlegen grosser Bilder
dauert sehr lange.