| Autor |
Beitrag |
daywalker0086 
      
Beiträge: 243
Delphi 2005 Architect
|
Verfasst: So 08.01.06 20:25
mein Quelltext:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117:
| unit caratech;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, Buttons, ComCtrls, FMTBcd, DB, SqlExpr, DBTables, OleServer, WordXP, DBClient, DBGrids, ExtCtrls, DBCtrls, Mask, Menus, IniFiles, XPMan, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, WinInet, jpeg, WinSock, IdFTP, IdAntiFreezeBase, IdAntiFreeze, ExtDlgs, printers, OleCtrls, SHDocVw;
type TForm1 = class(TForm) Label1: TLabel; Label2: TLabel; Label3: TLabel; EBild: TDBEdit; MainMenu1: TMainMenu; Datei1: TMenuItem; Schlieen1: TMenuItem; ClientDataSet1: TClientDataSet; DataSource1: TDataSource; ClientDataSet1ID: TAutoIncField; ClientDataSet1Sparte: TStringField; ClientDataSet1Bezeichnung: TStringField; ClientDataSet1Beschreibung: TMemoField; ClientDataSet1Bildname: TStringField; DBGrid1: TDBGrid; DBMemo1: TDBMemo; EBezeichnung: TDBEdit; CSparte: TDBComboBox; Label4: TLabel; Label5: TLabel; StatusBar1: TStatusBar; XPManifest1: TXPManifest; Bearbeiten1: TMenuItem; htmlDateierstellen1: TMenuItem; htmlDateihochladen1: TMenuItem; GroupBox1: TGroupBox; Button1: TButton; Button2: TButton; IdFTP1: TIdFTP; IdTCPClient1: TIdTCPClient; ProgressBar1: TProgressBar; IdAntiFreeze1: TIdAntiFreeze; Bilderhochladen1: TMenuItem; OpenPictureDialog1: TOpenPictureDialog; GroupBox2: TGroupBox; DBNavigator1: TDBNavigator; Vorschau1: TMenuItem; DBRichEdit1: TDBRichEdit; Button3: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Schlieen1Click(Sender: TObject); procedure htmlDateierstellen1Click(Sender: TObject); procedure htmlDateihochladen1Click(Sender: TObject); procedure FtpVerbindung; procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); procedure Bilderhochladen1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Vorschau1Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); Procedure CheckDatenbank(Datei,Text1,Text2:String); procedure Button3Click(Sender: TObject); private
procedure CreateParams(var Params: TCreateParams); override; public
end;
var FTP_info, host, ipad, clientverzeichnis, Serververzeichnis, Datendatei:string; RTT, code, hopCount: dword; FTP_Status:Integer; BytesToTransfer: LongWord; Form1: TForm1; inifile: TInifile; test, ftpdat: string; MyItem: TListItem; header, article, alkoven, teilintegriert, kastenwagen, wohnwagen, footer:String; SLHeader, SLArticle, SLAlkoven, SLTeilintegriert, SLKastenwagen, SLWohnwagen, SLFooter, flist, SLComplete: TStrings; implementation
uses Unit2;
{$R *.dfm}
Procedure CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; Begin SL.Create; SL.LoadFromFile(Datei); For I := Sl.Count -1 downto 0 Do if (Pos(Text1,SL[i]) > 0) AND (Pos(Text2,SL[i]) > 0) Then SL.delete(i); SL.SaveToFile(Datei); SL.Free; end; procedure TForm1.Button2Click(Sender: TObject); Begin Case CSparte.ItemIndex of 0 : CheckDatenbank(alkoven,EBezeichnung.Text,DBMemo1.Text); 1 : CheckDatenbank(Teilintegriert,EBezeichnung.Text, DBMemo1.Text); 2 : CheckDatenbank(Kastenwagen,EBezeichnung.Text, DBMemo1.Text); 3 : CheckDatenbank(Wohnwagen,EBezeichnung.Text, DBMemo1.Text); End; End; |
Was ist jetzt falsch? Immernoch unsatisfied forward or... Fehler
|
|
stifflersmom
      
Beiträge: 194
XP /XP PRO/ SuSE div.
D1 - D7, BDS 2006
|
Verfasst: So 08.01.06 20:28
Wie gesagt, Du würdest bestimmt noch darauf kommen, wenn Du mal ein wenig länger auf diesen
Quellcode und alle anderen die Du schon mit Delphi gebaut hast, schaust.
Gut, ich will mal nicht so sein:
aus:
Delphi-Quelltext 1: 2: 3:
| Procedure CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; |
wird:
Delphi-Quelltext 1: 2: 3:
| Procedure TForm1.CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; |
Na dann, viel Spaß
|
|
daywalker0086 
      
Beiträge: 243
Delphi 2005 Architect
|
Verfasst: So 08.01.06 20:45
Es tut mir leid dich imer belästigen zu müssen aber es gibt immernoch ein Problem, also mit dem TForm1 hät ich wirklich auch selbst drauf kommen müsen, aber hab nur im Implementationsteil geguggt
Aber wenn ich jetzt mein löschen Button drücke dann bekomm ich folgende Exception:
Access violation at adress 004037CE in module 'cara4tech.exe' Read of Adress 8BD88B4F
und er zeigt auf folgende Zeile:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9:
| procedure TForm1.Button2Click(Sender: TObject); Begin Case CSparte.ItemIndex of 0 : CheckDatenbank(alkoven,EBezeichnung.Text,DBMemo1.Text); <-- Hier wenn mein Index 0 war 1 : CheckDatenbank(Teilintegriert,EBezeichnung.Text, DBMemo1.Text); 2 : CheckDatenbank(Kastenwagen,EBezeichnung.Text, DBMemo1.Text); 3 : CheckDatenbank(Wohnwagen,EBezeichnung.Text, DBMemo1.Text); End; End; |
wo liegt da schonwieder der fehler?
|
|
stifflersmom
      
Beiträge: 194
XP /XP PRO/ SuSE div.
D1 - D7, BDS 2006
|
Verfasst: Mo 09.01.06 20:07
Kann ich jetzt wirklich nicht erkennen.
Da bleibt Dir nichts weiter übrig, als die routine "Checkdatenbanken" schrittweise mit F7 zu debuggen.
Dann bekommst Du die genaue Zeile in dem der Fehler auftritt.
Moin
|
|
daywalker0086 
      
Beiträge: 243
Delphi 2005 Architect
|
Verfasst: Mo 09.01.06 23:27
Habs gefunden!!!!
Es Muss heißen:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14:
| Procedure TForm1.CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; Begin
SL:=TStringList.Create; SL.LoadFromFile(Datei); For I := Sl.Count -1 downto 0 Do if (Pos(Text1,SL[i]) > 0) AND (Pos(Text2,SL[i]) > 0) Then SL.delete(i); SL.SaveToFile(Datei); SL.Free; end; |
|
|
stifflersmom
      
Beiträge: 194
XP /XP PRO/ SuSE div.
D1 - D7, BDS 2006
|
Verfasst: Di 10.01.06 20:00
Na wunderbar.
Und, läuft Dein Programm jetzt auch in einem anderen Verzeichnis?
Moin
|
|
daywalker0086 
      
Beiträge: 243
Delphi 2005 Architect
|
Verfasst: Di 10.01.06 21:24
Jo läuft jetzt auch in anderen Verzeichnissen, aber ein Problem gibts noch:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26:
| procedure TForm1.Button2Click(Sender: TObject); Begin Case CSparte.ItemIndex of 0 : CheckDatenbank(alkoven,EBezeichnung.Text,DBMemo1.Text); 1 : CheckDatenbank(Teilintegriert,EBezeichnung.Text, DBMemo1.Text) ; 2 : CheckDatenbank(Kastenwagen,EBezeichnung.Text, DBMemo1.Text); 3 : CheckDatenbank(Wohnwagen,EBezeichnung.Text, DBMemo1.Text) else exit; End; End;
Procedure TForm1.CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; Begin
SL:=TStringList.Create; SL.LoadFromFile(Datei); For I := Sl.Count -1 downto 0 Do if (Pos(Text1,SL[i]) > 0) AND (Pos(Text2,SL[i]) > 0) Then SL.delete(i); SL.SaveToFile(Datei); SL.Free; end; |
Immer wenn eigentlich Index 0 ausgewählt ist löscht das Programm einfach den Datensatz nicht.
Aber bei allen anderen Index(en  ) funktioniert es.
Ich hab keine Ahnung warum das so ist, ist auf alle Fählle schlecht, so wie es ist.
|
|
daywalker0086 
      
Beiträge: 243
Delphi 2005 Architect
|
Verfasst: Do 12.01.06 17:32
Also, weis jetzt warum er nicht jeden Eintrag löscht!
Wenn ich Text in mein DBMemofeld eingebe und ihn dann in meine Textdatei schreiben lasse und dann wieder meine Löschprozedur aufrufe löscht er den Text so wie es sein soll.
ABER wenn ich den Text in meinem DBMemo mit der Procedur:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8:
| procedure TForm1.Button4Click(Sender: TObject); begin if DBMemo1.SelText='' then exit else ClientDataSet1.Edit; DBMemo1.SelText := '<span style="color:#e2671c">'+DBMemo1.SelText+'</span>'; end; |
bearbeite und ihn dann der TextDatei hinzufüge, dann löscht er mir den Text anschließend nichtmehr
Hier nochmal meine schreib und löschproceduren:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63:
| procedure TForm1.HinzufuegenClick(Sender: TObject); Var Inhalt: string; begin if EBild.text= '' then Inhalt:='<tr> <td width="400">'+DBMemo1.Text+'<p align="right" style="color:#e2671c"><strong>'+DBErgaenzung.Text+'<strong></p><hr></td> <td valign="top"><span style="font-family:''Times New Roman'',Times,serif; font-weight:bold; font-size:12pt">'+EBezeichnung.Text+'</span><br><br></td></tr>' else Inhalt:='<tr> <td width="400">'+DBMemo1.Text+'<p align="right" style="color:#e2671c"><strong>'+DBErgaenzung.Text+'<strong></p><hr></td> <td valign="top"><span style="font-family:''Times New Roman'',Times,serif; font-weight:bold; font-size:12pt">'+EBezeichnung.Text+'</span><br><br><img src="data/images/gebrauchte/'+EBild.text+'.jpg"></td></tr>' ;
Begin Case CSparte.ItemIndex of 0 : Hinzufuegen(alkoven,'<tr><td align="left" colspan=2 style="font-family:''Times New Roman'',Times,serif; font-weight:bold; font-size:14pt; color:#E3C815; background-image:url(data/images/table_middle.gif)">Alkoven<br> </td></tr>',Inhalt); 1 : Hinzufuegen(alkoven,'<tr><td align="left" colspan=2 style="font-family:''Times New Roman'',Times,serif; font-weight:bold; font-size:14pt; color:#E3C815; background-image:url(data/images/table_middle.gif)">Teilintegrierte<br> </td></tr>',Inhalt); 2 : Hinzufuegen(alkoven,'<tr><td align="left" colspan=2 style="font-family:''Times New Roman'',Times,serif; font-weight:bold; font-size:14pt; color:#E3C815; background-image:url(data/images/table_middle.gif)">Kastenwagen<br> </td></tr>',Inhalt); 3 : Hinzufuegen(alkoven,'<tr><td align="left" colspan=2 style="font-family:''Times New Roman'',Times,serif; font-weight:bold; font-size:14pt; color:#E3C815; background-image:url(data/images/table_middle.gif)">Wohnwagen<br> </td></tr>',Inhalt); else exit; End; end; end;
procedure TForm1.Hinzufuegen(Datei,Suchtext,Text :String); Var I : Integer; SL : TstringList;
Begin
SL:=TStringList.Create; SL.LoadFromFile(Datei); For I := Sl.Count -1 downto 0 Do if (Pos(Suchtext,SL[i]) > 0) Then SL.Insert(I+1,Text);
SL.SaveToFile(Datei); SL.Free; end;
procedure TForm1.loeschenClick(Sender: TObject); Begin Case CSparte.ItemIndex of 0 : CheckDatenbank(alkoven,EBezeichnung.Text, DBMemo1.Text); 1 : CheckDatenbank(alkoven,EBezeichnung.Text, DBMemo1.Text) ; 2 : CheckDatenbank(alkoven,EBezeichnung.Text, DBMemo1.Text); 3 : CheckDatenbank(alkoven,EBezeichnung.Text, DBMemo1.Text) else exit; End; End;
Procedure TForm1.CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; Begin
SL:=TStringList.Create; SL.LoadFromFile(Datei); For I := Sl.Count -1 downto 0 Do if (Pos(Text1,SL[i]) > 0) and (Pos(Text2,SL[i]) > 0) Then SL.delete(i); SL.SaveToFile(Datei); SL.Free; end; |
ALso es liegt an meiner Procedure für das hinzufügen der html Tags aber kann mir da jemand sagen wie ich das anders schreiben kann, damit es dann funktioniert? Beim löschen vergleiche ich ja den Text im Memofeld und den Text in der Textdatei, nur irgendwie ist der Text nach dem hinzufügen der Tags nichtmehr der gleiche, obwohl er ja nach dem hinzufügen in der Textdatei steht. 
|
|
spaxxn
      
Beiträge: 31
WinXP SP3, Win2000 SP4, Debian Sarge
D7 EE, D2006 PE, D2007 EE
|
Verfasst: Mo 23.01.06 15:08
ich weiss ja net, ob das löschen problem noch besteht, aber:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13:
| Procedure CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; Begin SL.Create; SL.LoadFromFile(Datei); For I := Sl.Count -1 downto 0 Do if (Pos(Text1,SL[i]) > 0) AND (Pos(Text2,SL[i]) > 0) Then SL.delete(i); SL.SaveToFile(Datei); SL.Free; end; |
die liste wird schon beim ersten durchlauf freigegeben? wie soll das dann funktionieren? beim nächsten durchlauf, wird auf eine nicht mehr vorhandene liste zugegriffen. probier mal dies:
Delphi-Quelltext 1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19:
| Procedure CheckDatenbank(Datei,Text1,Text2:String); Var I : Integer; SL : TstringList; Begin try SL.Create; SL.LoadFromFile(Datei); i := 0; while i < SL.Count do begin if (Pos(Text1,SL[i]) > 0) AND (Pos(Text2,SL[i]) > 0) Then begin SL.delete(i) end else inc(i); end; SL.SaveToFile(Datei); finally SL.Free; end; end; |
nicht gleich hauen, aber hatte keine zeit mir alles vorher durchzulesen
edit: arbeite mal mit textformatierung bitte, dann sieht man auch was du da so proggst ...  das mit dem freigeben ziehe ich zurück
|
|
|