AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Fehler Meldung unterdrücken

Ein Thema von arbu man · begonnen am 18. Dez 2004 · letzter Beitrag vom 18. Dez 2004
 
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
 


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 05:52 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz