Einzelnen Beitrag anzeigen

Benutzerbild von arbu man
arbu man

Registriert seit: 3. Nov 2004
Ort: Krefeld
1.108 Beiträge
 
Delphi 7 Professional
 
#4

Re: Fehler Meldung unterdrücken

  Alt 18. Dez 2004, 13:21
Delphi-Quellcode:
unit unitmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, shellapi, ExtCtrls, unit1;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Panel1: TPanel;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure press(Sender: TObject; var Key: Char);
  private
    { Private-Deklarationen }
  public
    procedure splitString(const Source: String; const Delimiter: String; const Dest: TStringlist);
    procedure leseein;
    procedure dobe;
    procedure add(s:string);
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  sl:tstringlist;// sl= liste in die das script geladen wird
  c:int64;// c=cursor
  forgo:integer;// forgo = gehe hinter befehle
  be:tstringlist;//be = befehl für verarbeitung
  max:int64;//max = länge der primären stringliste
  filename:string;
  b:boolean;// für das beenden
  e:boolean;// für eingabe
  es:string;// befehl für eingabe

// für script


implementation

{$R *.dfm}

function Starte(verz, appname: string): boolean;
var StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  if verz[length(verz)]<>'\then verz:=verz+'\';
  FillChar(StartupInfo, SizeOf(TStartupInfo),0);
  StartupInfo.cb:=SizeOf(TStartupInfo);
  if CreateProcess(nil, PChar(verz+appname), nil, nil, false,
  NORMAL_PRIORITY_CLASS, nil, nil, startupinfo, ProcessInfo) then begin
    try
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
    finally
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
    result:=true;
  end
  else
    result:=false;
end;


procedure TForm1.splitString(const Source: String; const Delimiter: String; const Dest: TStringlist);
var count: Integer;
      LStartpos, LEndepos, LSourcelength: Integer;
      LDelimiterLength : Integer;
begin
   Dest.Clear;
   count := 1;
   LStartpos := 0;
   LEndepos := 0;
   LSourcelength := length(Source);
   LDelimiterLength := Length(Delimiter);
   while count <= LSourcelength do begin
      if copy(Source, count, LDelimiterLength) = Delimiter then begin
         LEndepos := count;
         dest.Add(copy(Source, LStartpos + 1, LEndepos - LStartpos - 1));
         LStartpos := count + LDelimiterLength - 1;
         inc(count,LDelimiterLength);
      end
      else begin
         inc(count);
      end;
   end;
   if LEndePos <> Count - LDelimiterLength then
         dest.Add(copy(Source, LStartpos + 1, count - LStartpos - 1));
end;

procedure TForm1.leseein;
var z1,z2: String;
begin
  z1:=sl[0]; // scriptnamen ermitteln
  z2:=z1+' - abu_scrit by arbutus';
  form1.Caption:=copy(z2,7,Length(z2));
  if copy(z1,0,6)<>'scriptthen begin
  showmessage('Die Datei ist kein gültiges abu script');
  exit;
  end;

  // hinter befehle gehen
  repeat forgo:=forgo+1; until sl[forgo]='befehle';
  c:=forgo;
  max:=sl.Count;
  dobe;
end;
Da müsste er drin sein
kommt bei print
Delphi-Quellcode:
procedure TForm1.dobe;
begin
  if e=false then begin
  if b=false then begin // zum schlißen
  // begin mit einlesen der befehle
  c:=c+1; // cursor weiter setzen
  if c>=max then begin form1.close;b:=true;exit;end else begin // wenn liste zuende
  if sl[c]='then begin dobe; exit;end; // bei leerstring witer
  try // falls was schif geht
  splitString(sl[c],'|',be); //zerlege befehl
  be.Add('');// damit keine fehler kommen
  //anweisung erkennen
  if be[0]='showmessagethen {try} showmessage(be[1]);{except be.clear;end}; //showmessage fumction
  if be[0]='endthen begin form1.SetFocus; form1.Close;b:=true; exit; end; // beenden
  if be[0]='haltthen sleep(strtoint(be[1])); //hate script an
  if be[0]='installthen begin // app starten und auf ende warten
    Starte(extractfilepath(application.ExeName),be[1]);;;;end;
  if be[0]='print'then begin {try} Add(be[1]);{except be.clear;end;};end; // zeile schreiben
  if be[0]='close'then application.Terminate;// aus
  if be[0]='rechnethen begin e:=true; es:=be[0]; edit1.SetFocus; end;
  if be[0]='waitthen begin e:=true; es:=be[0]; edit1.SetFocus; end;
  finally
  be.Clear;// stringliste für nächste anweisung vorbereiten
  if b=false then dobe; // wiederholen

  end;end;end;end;
end;
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
begin
  //allgemeine einstellungen
  //ende

  sl:=tstringlist.Create;// um Datei laden zu können
  forgo:=1; // nach script {name}
  c:=1;//cursor auf ersten befehl setzen
  be:=tstringlist.create;// für befehl verarbeitung
  if paramcount <> 0 then // überprüfe ob eine datei übergeben wurde
  begin
    filename := paramstr(1);
  end;
  if filename <> 'then begin // wenn ja lade sie
    sl.LoadFromFile(FileName); //lade datei
    form1.Show;
    leseein;
  end;
end;

procedure TForm1.add(s:string);
begin
  memo1.lines.Add(s);
  be.Clear; dobe;
end;

procedure TForm1.press(Sender: TObject; var Key: Char);
begin //bestätigung der eingabe
  if e=true then begin
  if key = #13 then begin
    add(eingabe(es,edit1.text));
    e:=false;// eingabe kommt aus unit1
    dobe;
  end;
  end;
end;

end.
Björn
>> http://bsnx.net <<
Virtual DP Stammtisch v1.0"iw" am 19.09.2007 - ich war dabei!
  Mit Zitat antworten Zitat