AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Sonstige Fragen zu Delphi Delphi Delphi-Programm stürzt aus (mir) unerklärlichen Gründen ab
Thema durchsuchen
Ansicht
Themen-Optionen

Delphi-Programm stürzt aus (mir) unerklärlichen Gründen ab

Ein Thema von deep_thought · begonnen am 25. Jan 2008 · letzter Beitrag vom 26. Jan 2008
Antwort Antwort
deep_thought

Registriert seit: 9. Nov 2007
22 Beiträge
 
#1

Delphi-Programm stürzt aus (mir) unerklärlichen Gründen ab

  Alt 25. Jan 2008, 22:48
Hallo!
Hab ein Stego-Programm (zum Verstecken von Dateien in Bildern) geschrieben (in Delphi 4), aber das Programm stürzt (im Leerlauf!) ohne erkennbaren Grund ab.
Tatsachen:
1. Ich verwende nicht mehrere Threads
2. Das Programm stürzt ab, wenn ich in dem "Openfiledialog" den Cursor länger über eine Datei gehalten habe, sodass der Hint mit Infos angezeigt wird, allerdings läuft es nach Anzeigen des Hints noch ca. 5 Sekunden
3. Das Programm stürzt mit folgender Fehlermeldung ab "access violation at ...: read of address ..."
4. Zu dem Zeitpunkt, da das Programm abstürzt läuft kein selbstgeschriebener Code
5. die einzigen (meiner Meinung nach) "kritischen" Codeschnipsel, die ich verwende sind prozeduren wie "move", um einen String in ein array of Byte zu lesen, oder sowas wie Blockread(F,Buff[5+length(S)],filesize(F));

da ich keinen blassen Schimmer habe, woran das nun genau liegt, hier nun der gesamte Quelltext (der unit1.pas)
Delphi-Quellcode:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ExtDlgs, Math, Spin, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Image1: TImage;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    ProgressBar1: TProgressBar;
    procedure FormResize(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    procedure setbit(X,Y,Bit: Longint; B: Boolean);
    function getbit(X,Y,Bit: Longint): Boolean;
  end;
  TBitposition = record
                  X,Y: longint;
                  Bit: Integer;
                 end;
  TParameter = record
                P: Integer;
                H,Shift,GesP,W: Longint;
               end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.setbit(X,Y,Bit: Longint; B: Boolean);
begin
 Image1.Picture.Bitmap.Canvas.Pixels[X,Y]:=
  (Image1.Picture.Bitmap.Canvas.Pixels[X,Y] and ($FFFFFFFF xor (1 shl Bit))) or
  (Byte(B) shl Bit);
end;

function TForm1.getbit(X,Y,Bit: Longint): Boolean;
begin
 result:=odd(Image1.Picture.Bitmap.Canvas.Pixels[X,Y] shr Bit);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 Edit1.Width:= Form1.CLientwidth - Edit1.Left;
 Progressbar1.Width:= Form1.CLientwidth - Progressbar1.Left;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Openpicturedialog1.execute then
  Image1.Picture.Loadfromfile(Openpicturedialog1.Filename);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 if Savepicturedialog1.execute then
  Image1.Picture.Savetofile(Savepicturedialog1.Filename);
end;

function generiereParameter(W,GesP: Longint; Pass: String): TParameter;
var J: Integer;
begin
 Result.H:=GesP div W;
 Result.P:=0;
 For J:=1 to length(Pass) do
  Result.P:=((Result.P shl (J mod 32)) or (Result.P shr (32-(J mod 32)))) xor ord(Pass[J]);
    // (P um J Bits nach links mit Carry) xor Pass[J]
 Result.Shift:=0;
 For J:=1 to length(Pass) do
  Result.Shift:=(Result.Shift * ord(Pass[J])*J) mod GesP; // (1 runter + 2 nach rechts)*ord(Passwortbuchstabe)
 Result.GesP:=GesP;
 Result.W:=W;
end;

function mixPixelNumber(I: Longint; Params: TParameter): Integer;
var J,X,Y,Z1,Z2: Integer;
begin
 I:=(I + Params.Shift) mod Params.GesP; // (1 runter + 2 nach rechts)*ord(Passwortbuchstabe)
 X:=I mod Params.W;
 Y:=I div Params.W;
 Y:=(Y+2*X) mod Params.H;

 Z1:=Params.W;
 Z2:=Params.W;
 while (Z1>0) and (Z2>X) do
  begin
   For J:=2 to Z2-1 do
    if Z2 mod J = 0 then
     begin
      X:=((X div J + 1) mod (Z2 div J))*J + ((X + Params.P) mod J);
      dec(Z1);
     end;
   dec(Z2);
  end;
 Z1:=Params.H;
 Z2:=Params.H;
 while (Z1>0) and (Z2>Y) do
  begin
   For J:=2 to Z2-1 do
    if Z2 mod J = 0 then
     begin
      Y:=((Y div J + 3) mod (Z2 div J))*J + ((Y + 2*Params.P) mod J);
      dec(Z1);
     end;
   dec(Z2);
  end;
 Result:=X + Params.W*Y;
end;

function rtp(I,GesB: longint; Params: TParameter): TBitposition;
var bpp,bpp3: integer;
begin
 if I<32 then
  begin
   Result.Bit:=8*(I mod 3);
   I:=mixPixelNumber(I div 3,Params);
   Result.X:=I mod Params.W;
   Result.Y:=I div Params.W;
  end
   else
  begin
   bpp:=ceil((GesB-32)/(Params.GesP-11));
   bpp3:=ceil(bpp/3);
   I:=I-32;
   Result.Bit:=((I mod bpp) mod bpp3 + 8*((I mod bpp) div bpp3));
   I:=(I div bpp) + 11;
   I:=mixPixelNumber(I,Params);
   Result.X:=I mod Params.W;
   Result.Y:=I div Params.W;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var F: File;
    Datalen,W: longint;
    S: String;
    I,J: longint;
    Buff: array of Byte;
    B: Byte;
    Pixelpos: TBitposition;
    Params: TParameter;
begin
 if Opendialog1.Execute then
  begin
   W:=Image1.Picture.Bitmap.Width;
   S:=Opendialog1.Filename;
   assignfile(F,S);
   S:=extractfilename(S);
   reset(F,1);
   Datalen:=filesize(F)+length(S)+5;
   setlength(Buff,Datalen);
   Blockread(F,Buff[length(S)+5],filesize(F));
   Buff[4]:=length(S);
   move(S[1],Buff[5],length(S));
   Buff[3]:=(Datalen shr 24) and $FF;
   Buff[2]:=(Datalen shr 16) and $FF;
   Buff[1]:=(Datalen shr 8) and $FF;
   Buff[0]:=Datalen and $FF;
   closefile(F);
   Params:=generiereParameter(W,W*Image1.Picture.Bitmap.Height,Edit1.Text);
   Progressbar1.Min:=0;
   Progressbar1.Max:=Datalen-1;
   Progressbar1.Position:=0;
   Progressbar1.Step:=1;
   For I:=0 to Datalen-1 do
    begin
     B:=Buff[I];
     For J:=0 to 7 do
      begin
       Pixelpos:=rtp(8*I + J,Datalen*8,Params);
       setbit(Pixelpos.X,Pixelpos.Y,Pixelpos.Bit,odd(B));
       B:=B shr 1;
      end;
     Progressbar1.Stepit;
    end;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var F: File;
    S,T: String;
    I,J,W,
    Datalen: longint;
    Buff: array of Byte;
    Pixelpos: TBitposition;
    Params: TParameter;
begin
 if Savedialog1.Execute then
  begin
   W:=Image1.Picture.Bitmap.Width;
   Datalen:=0;
   Params:=generiereParameter(W,W*Image1.Picture.Bitmap.Height,Edit1.Text);
   For I:=0 to 31 do
    begin
     Pixelpos:=rtp(I,0,Params);
     Datalen:=Datalen or (byte(getbit(Pixelpos.X,Pixelpos.Y,Pixelpos.Bit)) shl I);
    end;
   Setlength(Buff,Datalen);
   Params:=generiereParameter(W,W*Image1.Picture.Bitmap.Height,Edit1.Text);
   Progressbar1.Min:=0;
   Progressbar1.Max:=Datalen-1;
   Progressbar1.Position:=0;
   Progressbar1.Step:=1;
   For I:=0 to Datalen-1 do
    begin
     Buff[I]:=0;
     For J:=0 to 7 do
      begin
       Pixelpos:=rtp(I*8 + J,Datalen*8,Params);
       Buff[I]:=Buff[I] or (byte(getbit(Pixelpos.X,Pixelpos.Y,Pixelpos.Bit)) shl J);
      end;
     Progressbar1.Stepit;
    end;
   setlength(T,Buff[4]);
   Move(Buff[5],T[1],length(T));
   S:=extractfilepath(Savedialog1.Filename)+T;
   if fileexists(S) then
    begin
     Messagedlg('Die Datei '''+S+''' existiert bereits - Vorganng abgebrochen!',mterror,[mbOK],0);
     exit;
    end;
   assignfile(F,S);
   rewrite(F,1);
   Blockwrite(F,Buff[5+length(T)],Datalen - 5 - length(T));
   closefile(F);
  end;
end;

end.
ich hoffe, ihr könnt mir helfen und verzeiht mir die fehlende Kommentierung ...

mfg deep_thought
  Mit Zitat antworten Zitat
Benutzerbild von Luckie
Luckie

Registriert seit: 29. Mai 2002
37.621 Beiträge
 
Delphi 2006 Professional
 
#2

Re: Delphi-Programm stürzt aus (mir) unerklärlichen Gründen

  Alt 25. Jan 2008, 22:52
Häng das komplette Projekt mal an, damit man es mal kompilieren aufn laufe lassen kann, um zu sehen, ob es auf unseren Rechnen auch so reagiert. Tut es dass nicht, liegt das Problem bei dir: Virus oder defekte Delphi-Installation oder irgendeine Explorer-Shellextension (hast du in letzter Zeit was installiert, was sich in den Explorer einklingt?), die Mist baut. Das wäre so die ersten Ursachen, die mir so auf die Schnelle einfallen.
Michael
Ein Teil meines Codes würde euch verunsichern.
  Mit Zitat antworten Zitat
deep_thought

Registriert seit: 9. Nov 2007
22 Beiträge
 
#3

Re: Delphi-Programm stürzt aus (mir) unerklärlichen Gründen

  Alt 25. Jan 2008, 23:02
nuja, am explorer rum-installiert hab ich eigentlich nicht ... meine Platte hat vor nem Monat den Geist aufgegeben und ich hab ein Backup einspielen müssen (auf ne neue), aber seit dem hab ich ja schon mehr mit delphi geschrieben (und erstrecht mit openfiledialogs) ...
trotzdem erstmal thx

mfg deep_thought
Angehängte Dateien
Dateityp: rar stego_158.rar (157,9 KB, 3x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von sirius
sirius

Registriert seit: 3. Jan 2007
Ort: Dresden
3.443 Beiträge
 
Delphi 7 Enterprise
 
#4

Re: Delphi-Programm stürzt aus (mir) unerklärlichen Gründen

  Alt 25. Jan 2008, 23:18
Könntest du noch ein funktionierendes bild anhängen zum Testen. Ich habe grade so ein Bitmap gefunden, das will er nicht. Aber soweit ohne Absturz.
Dieser Beitrag ist für Jugendliche unter 18 Jahren nicht geeignet.
  Mit Zitat antworten Zitat
deep_thought

Registriert seit: 9. Nov 2007
22 Beiträge
 
#5

Re: Delphi-Programm stürzt aus (mir) unerklärlichen Gründen

  Alt 25. Jan 2008, 23:25
es gibt bitmaps, die er nicht will ?!? .. nuja, soweit ich weiß, gehen da eh nur .bmp-dateien ...
... hm, na dann ...

mfg deep_thought
Angehängte Dateien
Dateityp: rar testbild_135.rar (19,0 KB, 4x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von sirius
sirius

Registriert seit: 3. Jan 2007
Ort: Dresden
3.443 Beiträge
 
Delphi 7 Enterprise
 
#6

Re: Delphi-Programm stürzt aus (mir) unerklärlichen Gründen

  Alt 25. Jan 2008, 23:35
Ja, keine Ahnung. Hab mich auch gewundert. War ein Bitmap. Ich kanns dir leider nicht schicken, da der Inhalt des Bildes dies nicht erlaubt. Mir ist auch zu spät, da jetzt weiter nachzuforschen.

Aber ich bring dein Programm über den ÖffnenDialog nicht zum Abstürzen.
Dieser Beitrag ist für Jugendliche unter 18 Jahren nicht geeignet.
  Mit Zitat antworten Zitat
deep_thought

Registriert seit: 9. Nov 2007
22 Beiträge
 
#7

Re: Delphi-Programm stürzt aus (mir) unerklärlichen Gründen

  Alt 26. Jan 2008, 11:57
also heute morgen/mittag hab ich den fehler auch noch nicht rekonstruiert bekommen ... vllt. sollte ich mein OS mal neu installieren (oder gleich ein besseres )
thx für eure Hilfe, ich glaub, das Problem hat sich von selbst erledigt ...

mfg deep_thought
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 04:13 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz