Text in einer Datei suchen und auslesen lassen!

fidionael · Verfasst: So 18.06.06 12:55

Erstmal würde ich einen neuen Typ einführen in meiner Parse-Unit:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

type
  TGroupLeader = record
    Username: String[20];
    ID: String[2];
    GID: Integer;
  end;

Nun kann man ja nach dem Usernamen des Gruppenleiters als erstes Argument in der Userkette suchen. Wurde dies gefunden, sucht man am Anfang der Zeile die ID und danach die GID, richtig? Wenn das so stimmt schreibe ich die Parsing-Unit eben dementsprechend um, aber dann poste hier nochmal bitte das definitiv richtige Format einer Zeile in der Datei, denn

leader_id + ':' + gid + '::'+ gruppenleiter + restliche user

ist ja schon wieder etwas völlig anderes. Achte also auf jeden Fall auf die richtige Reihenfolge und die Anzahl der Doppelpunkte, etc. Dann sollte das alles recht schnell zu beheben sein.

Mfg

del1312 · Beiträge: 190

ok also die genaue syntax lautet:

Zitat:

pm:543::u019,u013,u034,u055

pm - ist der gruppenname, immer zweistellig
:
543 - Gruppen-ID und immer dreistellig
::
u019 - der gruppenleiter

,u013,u034 - das sind die user die in der gruppe mit drin sind

Zitat:

Nun kann man ja nach dem Usernamen des Gruppenleiters als erstes Argument in der Userkette suchen. Wurde dies gefunden, sucht man am Anfang der Zeile die ID und danach die GID, richtig?

mach es nicht so aufwendig. der gruppenleiter gibt ja seine user-nr ein hier als z.b u019 und dazu sein kennwort.
das programm erkennt nun aha u019 meldet sich an als ist er der eigentümer der gruppe pm. nun brauchst du nur nach pm suchen, dies ist einmalig in der datei und schon hast du die zeile. jetzt sollte man einfach den anfang der zeile abschneiden und in eimem wert speicher.

ganze zeile:
pm:543::u019,u013,u034,u055

anfang:
pm:543::u019,

abgeschnitten
u013,u034,u055

diese user sollen dann in der listbox erscheinen. nun kann ich weitere user aus der listbox2 hinzufügen oder austragen
wenn ich nun das programm speichern und beenden will wird einfach der abgeschnittene teil (mit den usern) zu dem anfang wieder drangebastelt und gespeichert.
sieht dann so aus:

pm:543::u019,u013,u034,u042,u049,u055

oh man, wenn wir das echt hinbekommen, schulde ich dir was, dann lass ich mir was einfallen

)

fidionael · Verfasst: Mo 19.06.06 00:21

Hallo!

Pünktlich zu Beginn des neuen Tages stelle ich dir nun mal meine neue Parsing-Unit vor. Ich habe sie nochmal komplett umgeschmissen und neu geschrieben. Sie sollte nun alles beinhalten was du willst - ich kann jedoch nicht garantieren, dass sie fehlerfrei läuft: ich habe alles ohne wirkliche Planung so runter geschrieben; es wäre ein Wunder, wenn keine Bugs existierten. Nun will ich sie dir nicht länger vorenthalten:

markieren

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:
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:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:

// Parsing Unit by Nikolas Jansen
// Version 1.4 (19. 06. 06)
unit Parsing;

interface

type
  TUserList = record
    Count: Integer;
    User: Array of String;
  end;

  TGroup = record
    Name: String;
    ID: Integer;
    Leader: String;
  end;

function GetGroupByName(filename: String; Group_Name: String) : TGroup;
function GetGroupByID(filename: String; Group_ID: Integer) : TGroup;
function GetGroupByLeader(filename: String; Group_Leader: String) : TGroup;

function GetUsers(filename: String; Group: TGroup) : TUserList;
function SaveUsers(filename: String; Group: TGroup; UserList: TUserList) :
  Boolean;

function GetSpareUsers(filename: String; ignore: TUserList) : TUserList;

implementation

uses SysUtils;

function GetGroupByName(filename: String; Group_Name: String) : TGroup;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Name:='';
    ID:=0;
    Leader:='';
  end;

  AssignFile(f,filename);
  {$I-} Reset(f); {$I+}
  if ioResult = 0 then
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Group_Name,buf) = 1 then begin
        with Result do begin
          Name:=Group_Name;
          ID:=StrToInt(Copy(buf,5,3));
          Leader:=Copy(buf,9,Pos(',',buf)-9);
        end;
        Break;
      end;
    end;
  CloseFile(f);
end;

function GetGroupByID(filename: String; Group_ID: Integer) : TGroup;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Name:='';
    ID:=0;
    Leader:='';
  end;

  AssignFile(f,filename);
  {$I-} Reset(f); {$I+}
  if ioResult = 0 then
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Format('%0.3d',[Group_ID]),buf) = 5 then begin
        with Result do begin
          Name:=Copy(buf,1,2);
          ID:=Group_ID;
          Leader:=Copy(buf,9,Pos(',',buf)-9);
        end;
        Break;
      end;
    end;
  CloseFile(f);
end;

function GetGroupByLeader(filename: String; Group_Leader: String) : TGroup;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Name:='';
    ID:=0;
    Leader:='';
  end;

  AssignFile(f,filename);
  {$I-} Reset(f); {$I+}
  if ioResult = 0 then
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Group_Leader,buf) = 9 then begin
        with Result do begin
          Name:=Copy(buf,1,2);
          ID:=StrToInt(Copy(buf,5,3));
          Leader:=Group_Leader;
        end;
        Break;
      end;
    end;
  CloseFile(f);
end;

function GetUsers(filename: String; Group: TGroup) : TUserList;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Count:=0;
    SetLength(User,0);
  end;

  AssignFile(f,filename);
  {$I-} Reset(f); {$I+}
  if ioResult = 0 then
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Group.Name,buf) = 1 then begin
        Delete(buf,1,Pos(',',buf));
        while Length(buf) > 0 do begin
          if Pos(',',buf) <> 0 then begin
            with Result do begin
              inc(Count);
              SetLength(User,Count);
              User[Count-1]:=Copy(buf,1,Pos(',',buf)-1);
            end;
            Delete(buf,1,Pos(',',buf));
          end else begin
            with Result do begin
              inc(Count);
              SetLength(User,Count);
              User[Count-1]:=buf;
            end;
            Delete(buf,1,Length(buf));
          end;
        end;
      end;
    end;
  CloseFile(f);
end;

function SaveUsers(filename: String; Group: TGroup; UserList: TUserList) :
  Boolean;
var f: Textfile;
    buf: Array of String;
    i: Integer;
begin
  Result:=True;
  SetLength(buf,1);

  AssignFile(f,filename);
  {$I-} Reset(f); {$I+}
  if ioResult <> 0 then Result:=False
  else begin
    while not eoF(f) do begin
      ReadLn(f,buf[High(buf)]);
      if Pos(Group.Name,buf[High(buf)]) = 1 then
        with Group do begin
          buf[High(buf)]:=Name+'::'+Format('%0.3d',[ID])+':'+Leader;
          if UserList.Count > 0 then buf[High(buf)]:=buf[High(buf)]+',';
          for i:=0 to (UserList.Count-1) do begin
            buf[High(buf)]:=buf[High(buf)]+UserList.User[i];
            if i<(UserList.Count-1) then buf[High(buf)]:=buf[High(buf)]+',';
          end;
        end;
      SetLength(buf,High(buf)+2);
    end;

    {$I-} Rewrite(f); {$I+}
    if ioResult <> 0 then Result:=False
    else for i:=0 to High(buf) do WriteLn(f,buf[i]);
  end;
  CloseFile(f);
end;

function GetSpareUsers(filename: String; ignore: TUserList) : TUserList;
var f: Textfile;
    buf: String;
    i: Integer;
begin
  with Result do begin
    Count:=0;
    SetLength(User,Count);
  end;

  AssignFile(f,filename);
  {$I-} Reset(f); {$I+}
  if ioResult = 0 then
    while not eoF(f) do begin
      ReadLn(f,buf);
      i:=0;
      while (i<ignore.Count) and (buf<>ignore.User[i]) do
        inc(i);
      if i = ignore.Count then
        with Result do begin
          inc(Count);
          SetLength(User,Count);
          User[Count-1]:=buf;
        end;
    end;
    CloseFile(f);
end;

end.

Sie funktioniert folgendermaßen:

markieren

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:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

// Laden der Informationen einer Gruppe
procedure TForm1.Button1Click(Sender: TObject);
var group: TGroup;
    groupUser, spareUser: TUserList;
    i: Integer;
begin
  Listbox1.Clear; Listbox2.Clear;

  group:=GetGroupByName('datei.txt','pm');
  groupUser:=GetUsers('datei.txt',group);
  
  for i:=0 to (groupUser.Count-1) do
    Listbox1.Items.Add(groupUser.User[i]);
  
  with groupUser do begin
    inc(Count);
    SetLength(User,Count);
    User[Count-1]:=group.Leader;
  end;
  spareUser:=GetSpareUsers('user.txt',groupUser);

  for i:=0 to (spareUser.Count-1) do
    Listbox2.Items.Add(spareUser.User[i]);
end;

// Speichern der Informationen einer Gruppe
procedure TForm1.Button2Click(Sender: TObject);
var group: TGroup;
    groupUser: TUserList;
    i: Integer;
begin
  group:=GetGroupByName('datei.txt','pm');
  with groupUser do begin
    Count:=0;
    SetLength(User,0);
  end;

  for i:=0 to (Listbox1.Count-1) do
    with groupUser do begin
      inc(Count);
      SetLength(User,Count);
      User[Count-1]:=Listbox1.Items[i];
    end;

  if not SaveUsers('datei.txt',group,groupUser) then
    MessageBox(Handle,'Speicherung fehlgeschlagen.',
               pChar(Caption),MB_ICONERROR);
end;

Zu meiner neuen Parsing-Unit sollte ich vielleicht noch kurz anmerken, dass du die Gruppe, da ich dir die Wahlmöglichkeit lassen wollte, sowohl by Name, als auch ID, als auch Username des Gruppenleiters suchen lassen kannst.

Ich hoffe, dass du dir das ungefähr so vorgestellt hast, bzw. das überhaupt alles funktioniert. Ich habe den Quelltext jetzt mal nicht kommentiert; das war mir zu stressig. Falls Fragen auftauchen sollten, frag einfach.

Mfg

Edit1:
Ich habe einige Bugs in der Parsing-Unit entfernt

Edit2:
So, die Schreib-Funktion ist nun auch wieder lauffähig und meine Testphase schließe ich hiermit offiziell ab. Mein laufendes Testprojekt hänge ich für dich mal an. BTW: Das Passwort-Feld soll nur schön aussehen - ist nicht implementiert *gg*

Edit3:
Hab doch noch einige kleine Bugs in der Parsing-Unit gefunden (z. B. hat diese beim Speichern die Group-ID zerschossen) und gefixed. Möglich, dass noch einige Nachträge dieser Art kommen, aber wir nähern uns dem "Stable Release" meiner Parsing-Unit

Edit4:
Da das Problem ja gelöst ist und es sich um ein sehr spezifisches Projekt handelte, habe ich den Dateianhang wieder entfernt.

del1312 · Beiträge: 190

super ich teste es grade und baue es noch ein wenig um. sieht aber schon sehr gut aus. werde es heute mal mit ein, zwei leuten testen und meld mich dann hier im laufe des tages nochmal! DANKE!

fidionael · Verfasst: Mo 19.06.06 12:05

Ich denke, dass ich nun die finale und stabile Fassung meiner Parsing-Unit (V1.5) veröffentlichen kann. Ich habe diese nun lang und ausgiebig getestet und keinen Fehler mehr gefunden.

markieren

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:
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:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:

// Parsing Unit by Nikolas Jansen
// Version 1.6b (08. 10. 06)
unit Parsing;

interface

const
  MsgInternal = 'Es ist ein interner Fehler aufgetreten!';

type
  TUserList = record
    Count: Integer;
    User: Array of String;
  end;

  TGroup = record
    Name: String;
    ID: Integer;
    Leader: String;
  end;

function GetGroupByName(filename: String; Group_Name: String) : TGroup;
function GetGroupByID(filename: String; Group_ID: Integer) : TGroup;
function GetGroupByLeader(filename: String; Group_Leader: String) : TGroup;

function GetUsers(filename: String; Group: TGroup) : TUserList;
function SaveUsers(filename: String; Group: TGroup; UserList: TUserList) :
  Boolean;

function GetSpareUsers(filename: String; ignore: TUserList) : TUserList;

implementation

uses SysUtils, Dialogs;

function GetGroupByName(filename: String; Group_Name: String) : TGroup;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Name:='';
    ID:=0;
    Leader:='';
  end;

  AssignFile(f,filename);
  Reset(f);
  try
    while not eoF(f) do begin
      ReadLn(f,buf);
      if (Pos(Group_Name,buf) = 1) and (buf[Pos(Group_Name,buf)+1]=':') then begin
        with Result do begin
          Name:=Group_Name;
          ID:=StrToInt(Copy(buf,Pos('::',buf)+2,3));
          Delete(buf,1,Pos(IntToStr(ID),buf)+3);
          if Pos(',',buf) > 0 then
            Leader:=Copy(buf,1,Pos(',',buf)-1)
          else
            Leader:=Copy(buf,1,Length(buf));
        end;
        Break;
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

function GetGroupByID(filename: String; Group_ID: Integer) : TGroup;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Name:='';
    ID:=0;
    Leader:='';
  end;

  AssignFile(f,filename);
  Reset(f);
  try
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Format('%0.3d',[Group_ID]),buf) = 5 then begin
        with Result do begin
          Name:=Copy(buf,1,Pos('::',buf)-1);
          ID:=Group_ID;
          Delete(buf,1,Pos(IntToStr(ID),buf)+3);
          if Pos(',',buf) > 0 then
            Leader:=Copy(buf,1,Pos(',',buf)-1)
          else
            Leader:=Copy(buf,1,Length(buf));
        end;
        Break;
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

function GetGroupByLeader(filename: String; Group_Leader: String) : TGroup;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Name:='';
    ID:=0;
    Leader:='';
  end;

  AssignFile(f,filename);
  Reset(f);
  try  
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Group_Leader,buf) = 9 then begin
        with Result do begin
          Name:=Copy(buf,1,Pos('::',buf)-1);
          ID:=StrToInt(Copy(buf,Pos('::',buf)+2,3));
          Leader:=Group_Leader;
        end;
        Break;
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

function GetUsers(filename: String; Group: TGroup) : TUserList;
var f: Textfile;
    buf: String;
begin
  with Result do begin
    Count:=0;
    SetLength(User,0);
  end;

  AssignFile(f,filename);
  Reset(f);
  try
    while not eoF(f) do begin
      ReadLn(f,buf);
      if Pos(Group.Name,buf) = 1 then begin
        if Pos(',',buf) > 0 then
          Delete(buf,1,Pos(',',buf))
        else
          Delete(buf,1,Length(buf));
        while Length(buf) > 0 do begin
          if Pos(',',buf) <> 0 then begin
            with Result do begin
              inc(Count);
              SetLength(User,Count);
              User[Count-1]:=Copy(buf,1,Pos(',',buf)-1);
            end;
            Delete(buf,1,Pos(',',buf));
          end else begin
            with Result do begin
              inc(Count);
              SetLength(User,Count);
              User[Count-1]:=buf;
            end;
            Delete(buf,1,Length(buf));
          end;
        end;
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

function SaveUsers(filename: String; Group: TGroup; UserList: TUserList) :
  Boolean;
var f: Textfile;
    buf: Array of String;
    i: Integer;
begin
  Result:=True;
  SetLength(buf,1);

  AssignFile(f,filename);
  try
    Reset(f);
    while not eoF(f) do begin
      ReadLn(f,buf[High(buf)]);
      if Pos(Group.Name,buf[High(buf)]) = 1 then
        with Group do begin
          buf[High(buf)]:=Name+'::'+Format('%0.3d',[ID])+':'+Leader;
          if UserList.Count > 0 then buf[High(buf)]:=buf[High(buf)]+',';
          for i:=0 to (UserList.Count-1) do begin
            buf[High(buf)]:=buf[High(buf)]+UserList.User[i];
            if i<(UserList.Count-1) then buf[High(buf)]:=buf[High(buf)]+',';
          end;
        end;
      SetLength(buf,High(buf)+2);
    end;

    Rewrite(f);
    for i:=0 to High(buf) do WriteLn(f,buf[i]);

    CloseFile(f);
  except
    Result := False;
  end;
end;

function GetSpareUsers(filename: String; ignore: TUserList) : TUserList;
var f: Textfile;
    buf: String;
    i: Integer;
begin
  with Result do begin
    Count:=0;
    SetLength(User,Count);
  end;

  AssignFile(f,filename);
  Reset(f);
  try
    while not eoF(f) do begin
      ReadLn(f,buf);
      i:=0;
      while (i<ignore.Count) and (buf<>ignore.User[i]) do
        inc(i);
      if i = ignore.Count then
        with Result do begin
          inc(Count);
          SetLength(User,Count);
          User[Count-1]:=buf;
        end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

end.

Im Gegensatz zur V1.4 kann diese übrigens nun auch damit umgehen, wenn in einer Zeile (außer dem Gruppenleiter) keine User angegeben sind. Ich denke, damit sollten all deine Probleme bezüglich Parsing in diesem Fall gelöst sein.

Noch viel Spaß beim Programmieren deines Tools!

Post Scriptum: Mein Testprojekt habe ich oben aktualisiert.

Edit: V1.6:
- Die Compileranweisungen {$I-} und {$I+} wurden mit try except Blöcken ausgetauscht.
- Es wurde eine konstante Fehlermeldung hinzugefügt
- Die function GetGroupByName gibt jetzt auch korrekte Werte zurück, wenn vor dem Auftreten des gesuchten Gruppennamens ein Gruppenname auftaucht, der den gesuchten beinhaltet (wenn z. B. abc gesucht wird, vorher aber bereits abcd auftaucht.

Edit: V1.6b:
- Die Erweiterung zu V1.6 zog einige Bugs bei der Gruppenerkennung mit sich, die nun behoben wurden.

del1312 · Beiträge: 190

supi mein problem ist gelöst, nochmal ein

riesen dankeschön an fidionael

fidionael · Verfasst: So 08.10.06 14:06

Tut mir Leid, dass ich so einen alten Thread nochmal aufmachen muss, aber da es sich hierbei um eine beträchtliche Änderung der Parsing-Unit handelt und das Projekt auch (entgegen dem letzten Posting) noch nicht abgeschlossen ist (Anfrage per PN), erscheint es mir als notwendig.

Version 2.0 (beta)

markieren

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:
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:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:

// Parsing Unit by Nikolas Jansen
// V 2.0 (beta) (08. 10. 06)

///////////////////////////////////////////////////////////////////////////////
// Class TGroup (derived from TObject)
// Methods
//   constructor CreateByName(filename_accounts,filename_userlist: String;
//     Group_Name: String);
//     (former name: GetGroupByName)
//   constructor CreateByID(filename_accounts,filename_userlist: String;
//     Group_ID: Integer);
//     (former name: GetGroupByID)
//   constructor CreateByLeader(filename_accounts,filename_userlist: String;
//     Group_Leader: String);
//     (former name: GetGroupByLeader)
//   procedure UpdateFile(filename: String);
//     (former name: SaveUsers)
//   function GetGroupUser(index: Integer) : String;
//     returns name of user in list with given index
//   function GetSpareUser(index: Integer) : String;
//     returns name of user in list with given index
// Properties
//   Group_User_Count: Word (0-65535) (READ-ONLY)
//   Spare_User_Count: Word (0-65535) (READ-ONLY)
///////////////////////////////////////////////////////////////////////////////
unit Parsing;

interface

type
  PString = ^TString;
  TString = record
    Content: String;
    Next: PString;
  end;

  TGroup = class(TObject)
  private
    Name: String;
    ID: Integer;
    Leader: String;

    Groupcount: Word;
    Groupusers: PString;
    Sparecount: Word;
    Spareusers: PString;

    procedure GetGroupData(filename: String);
    procedure GetSpareData(filename: String);
  public
    constructor CreateByName(filename_accounts, filename_userlist: String;
      Group_Name: String);
    constructor CreateByID(filename_accounts, filename_userlist: String;
      Group_ID: Integer);
    constructor CreateByLeader(filename_accounts, filename_userlist: String;
      Group_Leader: String);

    procedure UpdateFile(filename: String);

    function GetGroupUser(index: Integer) : String;
    function GetSpareUser(index: Integer) : String;
    property Group_User_Count: Word read Groupcount;
    property Spare_User_Count: Word read Sparecount;
  end;

const
  MsgInternal = 'Es ist ein interner Fehler aufgetreten.';

implementation

uses SysUtils, Dialogs;

constructor TGroup.CreateByName(filename_accounts, filename_userlist: String;
  Group_Name: String);
var f: Textfile;
    buf: String;
begin
  Name := Group_Name;
  ID := 0;
  Leader := '';

  AssignFile(f,filename_accounts);
  try
    Reset(f);
    while not EoF(f) do begin
      Readln(f,buf);
      if (Pos(Group_Name,buf) = 1) and (buf[Pos(Group_Name,buf)+1]=':') then begin
        Name:=Group_Name;
        ID:=StrToInt(Copy(buf,Pos('::',buf)+2,3));
        Delete(buf,1,Pos(IntToStr(ID),buf)+3);
        if Pos(',',buf) > 0 then
          Leader:=Copy(buf,1,Pos(',',buf)-1)
        else
          Leader:=Copy(buf,1,Length(buf));
      end;
      Break;
    end;

    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;

  GetGroupData(filename_accounts);
  GetSpareData(filename_userlist);
end;

constructor TGroup.CreateByID(filename_accounts, filename_userlist: String;
  Group_ID: Integer);
var f: Textfile;
    buf: String;
begin
  Name := '';;
  ID := Group_ID;
  Leader := '';

  AssignFile(f,filename_accounts);
  try
    Reset(f);
    while not EoF(f) do begin
      Readln(f,buf);
      if Pos(Format('%0.3d',[Group_ID]),buf) = Pos('::',buf)+2 then begin
        Name:=Copy(buf,1,Pos('::',buf)-1);
        ID:=Group_ID;
        Delete(buf,1,Pos(IntToStr(ID),buf)+3);
        if Pos(',',buf) > 0 then
          Leader:=Copy(buf,1,Pos(',',buf)-1)
        else
          Leader:=Copy(buf,1,Length(buf));
      end;
      Break;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;

  GetGroupData(filename_accounts);
  GetSpareData(filename_userlist);
end;

constructor TGroup.CreateByLeader(filename_accounts, filename_userlist: String; Group_Leader: String);
var f: Textfile;
    buf: String;
begin
  Name := '';;
  ID := 0;
  Leader := Group_Leader;

  AssignFile(f,filename_accounts);
  try
    Reset(f);
    while not EoF(f) do begin
      Readln(f,buf);
      if Pos(Group_Leader,buf) = Pos('::',buf)+6 then begin
        Name:=Copy(buf,1,Pos('::',buf)-1);
        ID:=StrToInt(Copy(buf,Pos('::',buf)+2,3));
        Leader:=Group_Leader;
        Break;
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;

  GetGroupData(filename_accounts);
  GetSpareData(filename_userlist);
end;

procedure TGroup.GetGroupData(filename: String);
var f: Textfile;
    buf: String;
    temp,current: PString;
begin
  Groupcount := 0;
  Groupusers := nil;

  AssignFile(f,filename);
  try
    Reset(f);
    while not EoF(f) do begin
      Readln(f,buf);
      if Pos(Name,buf) = 1 then begin
        if Pos(',',buf) > 0 then
          Delete(buf,1,Pos(',',buf))
        else
          Delete(buf,1,Length(buf));
        while Length(buf) > 0 do begin
          temp := New(PString);
          if Pos(',',buf) > 0 then
            temp^.Content := Copy(buf,1,Pos(',',buf)-1)
          else
            temp^.Content := buf;
          temp^.Next := nil;
          current := Groupusers;
          while current^.Next <> nil do
            current := current^.Next;
          current.Next := temp;
          inc(Groupcount);
        end;
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

procedure TGroup.GetSpareData(filename: String);
var f: Textfile;
    buf: String;
    i: Integer;
    temp, current: PString;
begin
  Sparecount := 0;
  Spareusers := nil;

  AssignFile(f,filename);
  try
    Reset(f);
    while not EoF(f) do begin
      Readln(f,buf);
      i := 0;
      current := Groupusers;
      while (current^.Next <> nil) and (current^.Next^.Content <> buf) do begin
        current := current^.Next;
        inc(i);
      end;
      if i = Groupcount then begin
        temp := New(PString);
        temp^.Content := buf;
        temp^.Next := nil;
        current := Spareusers;
        while current^.Next <> nil do
          current := current^.Next;
        current^.Next := temp;
        inc(Sparecount);
      end;
    end;
    CloseFile(f);
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

procedure TGroup.UpdateFile(filename: String);
var f: Textfile;
    buf: String;
    first,current,current2,temp: PString;
    i: Integer;
begin
  first := nil;

  AssignFile(f,filename);
  try
    Reset(f);
    while not EoF(f) do begin
      Readln(f,buf);
      temp := New(PString);
      temp^.Content := buf;
      temp^.Next := nil;
      current := first;
      while current^.Next <> nil do
        current := current^.Next;
      current^.Next := temp;
    end;
    CloseFile(f);

    Rewrite(f);
    current := first;
    while current^.Next <> nil do begin
      current := current^.Next;
      if Pos(Name,current^.Content) = 1 then begin
        buf := Format('%s::%0.3d:%s',[Name,ID,Leader]);
        if Groupcount > 0 then begin
          current2 := Groupusers;
          for i := 1 to Groupcount do begin
            current2 := current2^.Next;
            buf := buf + ',' + current2^.Content;
          end;
        end;
        Writeln(f,buf);
      end else Writeln(f,current^.Content);
    end;
  except
    MessageDlg(MsgInternal,mtError,[mbOK],0);
  end;
end;

function TGroup.GetGroupUser(index: Integer) : String;
var i: Integer;
    current: PString;
begin
  Result := '';

  current := Groupusers;
  if index <= Groupcount then begin
    for i := 1 to index do
      current := current^.Next;
    Result := current^.Content;
  end;
end;

function TGroup.GetSpareUser(index: Integer) : String;
var i: Integer;
    current: PString;
begin
  Result := '';

  current := Spareusers;
  if index <= Sparecount then begin
    for i := 1 to index do
      current := current^.Next;
    Result := current^.Content;
  end;
end;

end.

Neuerungen:
- Eine Eingliederung in die Klasse TGroup, welche sich schon seit mehreren Versionen anbot, jedoch nicht durchgeführt wurde, da sich das Projekt vermeintlich am Ende befand und dies eine größere Umstellung bedeuten würde, hat nun endlich statt gefunden.
- Im Zuge der Umstellung auf OOP (objektorientierte Programmierung) wurden einige Methoden aus der alten Unit völlig überflüssig, es wurden alle überarbeitet. Eine Kurzerklärung befindet sich im Kommentar der Unit, eine ausführliche Dokumentation wird hier noch folgen.

Zu beachten ist, dass es sich um eine beta-Version handelt, welche vermutlich noch voller Fehler steckt. Sobald diese getestet ist und auch die Dokumentation mit Anwendungsbeispielen fertiggestellt ist, werde ich die Version dann offiziell freigeben.

Mfg.

del1312 · Beiträge: 190

hallo fidionael,
ich danke dir für deine schnelle hilfe, werd es gleich mal ausprobieren

)

fidionael · Verfasst: Di 20.03.07 17:57

Nach langer, langer Zeit habe ich meine Beta-Version nun doch nochmal überarbeitet und endlich, nachdem ich sie auch in Delphi testen konnte, soweit ich das bisher sehen konnte, fehlerfrei.

Ich hänge an diesen Post auch mal mein Testprogramm an. Mögliche Logins sind als Gruppenname z. B. aa, oder ab. Ansonsten einfach in die entsprechende Datei gucken.

Nun erstmal der Quelltext; kommentiert ist er bereits, aber eine ausführliche Dokumentation wird folgen.

markieren

Version 2.2

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:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:

///////////////////////////////////////////////////////////////////////////////
// Parsing Unit by Nikolas Jansen
// Version: 2.2 (21.03.07)
unit Parsing;

interface

type
  TListNode = class(TObject)    // Interne Klasse von TStringList
  private
    fvalue: String;
  public
    next: TListNode;
    constructor Create(val: String);
    property Value: String read fvalue;
  end;

  TStringList = class(TObject)
  private
    dummy, current: TListNode;
    fcount: Word;
  public
    constructor Create;         // Initialisiert die Liste
    procedure Reset;            // Setzt current = dummy
    procedure Advance;          // current <> nil ? current = current.next
    function EndPos : Boolean;  // Gibt TRUE zurück wenn current.next = nil
    procedure Add(val: String); // Fügt Element hinter current ein
    procedure Delete;           // Entfernt Element hinter current
    function Get : String;      // Gibt Element hinter current zurück
    destructor Free;            // Gibt allokierten Speicher wieder frei

    property Count: Word read fcount;
  end;

  TUserList = class(TStringList)// Interne Klasse von TGroup
  public
    procedure Delete(val: String);
                                // Löscht Element mit Wert val
    function Exists(val: String) : Boolean;
                                // Gibt TRUE zurück wenn Element in Liste
  end;

  TGroup = class(TObject)
  protected
    procedure Init(filename_groups: String);
                                // Initialisiert die Variablen, die in allen
                                // Konstruktern gleich initialisiert werden;
                                // dient der Quelltextverkürzung
    procedure CreateLists(filename_users: String);
                                // Füllt fuser und fspare in den Konstruktern;
                                // dient der Quelltextverkürzung

    function GetUserCount : Word;
                                // Für User_Count-Property
    function GetSpareUserCount : Word;
                                // Für SpareUser_Count-Property
  private
    fname, fleader: String;
    fid: Integer;
    fuser, fspare: TUserList;

    ffilegroups: String;        // Wird für Save-Prozedur behalten

    ferror : Boolean;           // Error-Flag, wird TRUE gesetzt wenn ein Fehler
                                // auftritt; erlaubt dem Nutzer selbst zu ent-
                                // scheiden, wie er mit Fehlern umgeht; auslesen
                                // in der ErrorFlag-Property
  public
    constructor CreateByName(filename_groups,filename_users: String;
      group_name: String);
    constructor CreateByLeader(filename_groups,filename_users: String;
      group_leader: String);
    constructor CreateByID(filename_groups,filename_users: String;
      group_id: Integer);

    function AddUser(val: String) : Boolean;
                                // Gibt zurück, ob User eingefügt werden konnte
                                // (Einfügen ist nur möglich, wenn der User in
                                // der Userdatei existiert)
    function DelUser(val: String) : Boolean;
                                // Gibt zurück, ob User gelöscht werden konnte
                                // (s. AddUser)

    function GetUser(index: Word) : String;
                                // Gibt Usernamen an entsprechender Stelle der
                                // Liste zurück; bei Listenende wird ein leerer
                                // String zurückgegeben
    function GetSpareUser(index: Word) : String;
                                // s. GetUser

    procedure Save;             // Speichert alle vorgenommenen Änderungen;
                                // Schreibrechte in der Gruppendatei sind
                                // notwendig

    destructor Free;            // Gibt allokierten Speicherplatz wieder frei

    property User_Count: Word read getUserCount;
    property SpareUser_Count: Word read getSpareUserCount;
    property ErrorFlag: Boolean read ferror;

    property Name: String read fname;
    property Leader: String read fleader;
    property ID: Integer read fid;
  end;

implementation

uses SysUtils;

///////////////////////////////////////////////////////////////////////////////
// Implementation der Klasse TListNode

constructor TListNode.Create(val: String);
begin
  fvalue := val;
  next := nil;
end;

///////////////////////////////////////////////////////////////////////////////
// Implementation der Klasse TStringList

constructor TStringList.Create;
begin
  dummy := TListNode.Create('');
  current := dummy;
  fcount := 0;
end;

procedure TStringList.Delete;
var temp: TListNode;
begin
  if not self.EndPos then begin
    temp := current.next;
    current.next := current.next.next;
    temp.Free;
    dec(fcount);
  end;
end;

procedure TStringList.Reset;
begin
  current := dummy;
end;

procedure TStringList.Advance;
begin
  if not self.EndPos then
    current := current.next;
end;

function TStringList.EndPos : Boolean;
begin
  Result := (current.next = nil);
end;

procedure TStringList.Add(val: String);
var temp: TListNode;
begin
  temp := TListNode.Create(val);
  temp.next := current.next;
  current.next := temp;
  current := temp;
  inc(fcount);
end;

function TStringList.Get : String;
begin
  if not self.EndPos then
    Result := current.next.Value
  else
    Result := '';
end;

destructor TStringList.Free;
begin
  self.Reset;
  Repeat
    self.Delete;
  Until self.EndPos;
end;

///////////////////////////////////////////////////////////////////////////////
// Implementation der Klasse TUserList

procedure TUserList.Delete(val: String);
var temp: TListNode;
begin
  temp := current; // Speichert Position vom current um Ursprungszustand wieder
                   // herstellen zu können
  self.Reset;
  while (not self.EndPos) and (self.Get <> val) do
    self.Advance;
  inherited Delete;
  current := temp;
end;

function TUserList.Exists(val: String) : Boolean;
var temp: TListNode;
begin
  Result := False;
  temp := current; // Speichert Position von current um Ursprungszustand wieder
                   // herstellen zu können
  self.Reset;
  Repeat
    if self.Get = val then begin
      Result := True;
      break;
    end;
    Advance;
  Until self.EndPos;
  current := temp;
end;

///////////////////////////////////////////////////////////////////////////////
// Implementation der Klasse TGroup

constructor TGroup.CreateByName(filename_groups,filename_users: String;
  group_name: String);
var f: Textfile;
    buf: String;
begin
  // Initialisierung der Variablen
  fname := group_name;
  fleader := '';
  fid := 0;
  self.Init(filename_groups);
  // Auslesen der Gruppendatei
  AssignFile(f,filename_groups);
  Reset(f);
  try
    while not eof(f) do begin
      Readln(f,buf);
      if (Pos(group_name,buf) = 1) and (buf[Pos(group_name,buf) +
          Length(group_name)]=':') then begin
        fid := StrToInt(Copy(buf,Pos('::',buf)+2,3));
        Delete(buf,1,Pos(IntToStr(fid),buf)+1);
        if Pos(',',buf) > 0 then
          fleader := Copy(buf,1,Pos(',',buf)-1)
        else
          fleader := Copy(buf,1,Length(buf));
        break;
      end;
    end;
    CloseFile(f);
  except
    ferror := True;
    Exit;
  end;
  if (fid = 0) or (fleader = '') then begin
    ferror := true;
    Exit;
  end;
  // Erstellen der Benutzerlisten
  self.CreateLists(filename_users);
end;

constructor TGroup.CreateByLeader(filename_groups,filename_users: String;
  group_leader: String);
var f: Textfile;
    buf: String;
begin
  // Initialisieren der Variablen
  fname := '';
  fleader := group_leader;
  fid := 0;
  self.Init(filename_groups);
  // Auslesen der Gruppendatei
  AssignFile(f,filename_groups);
  Reset(f);
  try
    while not eof(f) do begin
      Readln(f,buf);
      if Pos(group_leader,buf) = 9 then begin
        fname := Copy(buf,1,Pos('::',buf)-1);
        fid := StrToInt(Copy(buf,Pos('::',buf)+2,3));
        break;
      end;
    end;
    CloseFile(f);
  except
    ferror := True;
    Exit;
  end;
  if (fname = '') or (fid = 0) then begin
    ferror := True;
    Exit;
  end;
  // Erstellen der Benutzerlisten
  self.CreateLists(filename_users);
end;

constructor TGroup.CreateByID(filename_groups,filename_users: String;
  group_id: Integer);
var f: Textfile;
    buf: String;
begin
  // Initialisieren der Variablen
  fname := '';
  fleader := '';
  fid := group_id;
  self.Init(filename_groups);
  // Auslesen der Gruppendatei
  AssignFile(f,filename_groups);
  Reset(f);
  try
    while not eof(f) do begin
      Readln(f,buf);
      if Pos(Format('%0.3d',[group_id]),buf) = 5 then begin
        fname := Copy(buf,1,Pos('::',buf)-1);
        Delete(buf,1,Pos(IntToStr(group_id),buf)+1);
        if Pos(',',buf) > 0 then
          fleader := Copy(buf,1,Pos(',',buf)-1)
        else
          fleader := Copy(buf,1,Length(buf));
        break;
      end;
    end;
    CloseFile(f);
  except
    ferror := True;
    Exit;
  end;
  if (fname = '') or (fleader = '') then begin
    ferror := True;
    Exit;
  end;
  // Erstellen der Benutzerlisten
  self.CreateLists(filename_users);
end;

procedure TGroup.Init(filename_groups: String);
begin
  fuser := TUserList.Create;
  fspare := TUserList.Create;

  ffilegroups := filename_groups;

  ferror := False;
end;

procedure TGroup.CreateLists(filename_users: String);
var f: Textfile;
    buf: String;
begin
  // Füllen von fuser
  AssignFile(f,ffilegroups);
  Reset(f);
  try
    while not eof(f) do begin
      Readln(f,buf);
      if Pos(fname,buf) = 1 then begin
        if Pos(',',buf) > 0 then
          Delete(buf,1,Pos(',',buf))
        else
          Delete(buf,1,Length(buf));
        while Length(buf) > 0 do begin
          if Pos(',',buf) > 0 then begin
            fuser.Add(Copy(buf,1,Pos(',',buf)-1));
            Delete(buf,1,Pos(',',buf));
          end else begin
            fuser.Add(buf);
            Delete(buf,1,Length(buf));
          end;
        end;
      end;
    end;
    CloseFile(f);
  except
    ferror := True;
    Exit;
  end;
  // Füllen von fspare
  AssignFile(f,filename_users);
  Reset(f);
  try
    while not eof(f) do begin
      Readln(f,buf);
      if (not fuser.Exists(buf)) and (buf <> fleader) then
        fspare.Add(buf);
    end;
    CloseFile(f);
  except
    ferror := True;
    Exit;
  end;
end;

function TGroup.GetUserCount : Word;
begin
  Result := fuser.Count;
end;

function TGroup.GetSpareUserCount : Word;
begin
  Result := fspare.Count;
end;

function TGroup.AddUser(val: String) : Boolean;
begin
  if fspare.Exists(val) then begin
    fspare.Delete(val);
    fuser.Add(val);
    Result := True;
  end else Result := False;
end;

function TGroup.DelUser(val: String) : Boolean;
begin
  if fuser.Exists(val) then begin
    fuser.Delete(val);
    fspare.Add(val);
    Result := True;
  end else Result := False;
end;

function TGroup.GetUser(index: Word) : String;
var i: Integer;
begin
  fuser.Reset;
  for i := 1 to index do
    fuser.Advance;
  Result := fuser.Get;
end;

function TGroup.GetSpareUser(index: Word) : String;
var i: Integer;
begin
  fspare.Reset;
  for i := 1 to index do
    fspare.Advance;
  Result := fspare.Get;
end;

procedure TGroup.Save;
var f: Textfile;
    buf: String;
    list: TStringList;
begin
  // Initialisieren der Liste und Öffnen der Datei
  list := TStringList.Create;
  AssignFile(f,ffilegroups);
  try
    // Auslesen und Modifizieren der Datei
    Reset(f);
    while not eof(f) do begin
      Readln(f,buf);
      if (Pos(fname,buf) = 1) and (buf[Pos(fname,buf)+Length(fname)] = ':') then begin
        buf := fname+'::'+Format('%0.3d',[fid])+':'+fleader;
        fuser.Reset;
        while not fuser.EndPos do begin
          buf := buf+','+fuser.Get;
          fuser.Advance;
        end;
      end;
      list.Add(buf);
    end;
    // Schreiben der modifizierten Datei
    Rewrite(f);
    list.Reset;
    while not list.EndPos do begin
      Writeln(f,list.Get);
      list.Advance;
    end;
    CloseFile(f);
    list.Free;
  except
    ferror := True;
    Exit;
  end;
end;

destructor TGroup.Free;
begin
  fuser.Free;
  fspare.Free;
end;

end.

Ich hoffe, es ist noch hilfreich.

Update zu Version 2.1: Bug (Groupname "ab" - "ablage") fixed.

Update zu Version 2.2: Bug in TGroup.Save fixed. Aufsplittung TUserList in TStringList und TUserList(derived). TGroup.Save wurde durch die Verwendung verketteter Listen anstatt dyn. Arrays effizienter gemacht (sowohl Geschwindigkeit als auch RAM-Nutzung).

Einloggen, um Attachments anzusehen!

del1312 · Beiträge: 190

ja auf jedenfall ist das noch aktuelle, ich danke dir

)

del1312 · Beiträge: 190

hab da leider doch noch nen bug gefunden. versuch mal mit der grupppendatei die im anhang hab und log dich mal als "ab" ein. da siehste dann ein paar user. jetzt logst du dich wieder aus und gleich mal wieder als "ab" ein und schwupps sind es plötzlich mehr geworden. ursache: in der gruppendatei gibt es eine gruppe die auch mit "ab" anfängt "ablage" und da liest er auch alles raus und kopiert das in die gruppe "ab" im prinzip muss vorher die abfrage so sein: wenn "ab:" dann führe aus sonst lass es einfach stehen. also die gruppen sind immer zweistellig von daher muß ein : hinterher kommen, wenn du die abfrage so ändern könntest das er noch da nachschaut sollte es keine verwechselungen mehr geben und klappen

)

Einloggen, um Attachments anzusehen!

fidionael · Verfasst: Mi 21.03.07 19:18

Hallo,

das Problem lag gar nicht im Auslesen des Gruppennamens, sondern im Schreiben der Datei beim Ausloggen :-)

Weil wir das Problem ja schonmal thematisiert hatten, hatte ich es auch in der Auslese-Methode durchaus berücksichtigt. Nur habe ich leider vergessen, auch beim Schreiben der Datei hierauf zu achten :-)

Falls es dich interessiert, fügte er tatsächlich gar keine neuen Nutzer hinzu, sondern machte nur aus "ablage" eine zweite, identische Gruppe "ab" wodurch sich dann die Anzahl Nutzer verdoppelt hat - was man endlos weiterspielen konnte.

Das Problem ist jedenfalls nun behoben, der neue Quelltext ist in meinem letzten Posting zu finden. Ich habe jedoch die Parsing-Unit im Demo-Projekt nicht verändert - das musst du selbst tun.

Falls sonst noch Probleme auftreten, melde dich bitte wieder.

del1312 · Beiträge: 190

alles klar ich danke dir, bau mir das gleich mal so um wie ich es brauche. danke nochmal!

fidionael · Verfasst: Mi 21.03.07 22:55

Hallo, ich muss nochmal stören. Ich hab noch einen Fehler in meinem Quelltext (TGroup.Save) gefunden :oops:

Dieser ist jedenfalls jetzt behoben und, da ich schonmal dabei war, habe ich die TUserList in TStringList und TUserList aufgeteilt um die dynamischen Arrays aus der Save-Prozedur rausschmeißen zu können. Nun ist diese viel effizienter. Der Vollständigkeit halber sollte man vielleicht noch erwähnen, dass ich auch die Listenfunktion des Einfügens verändert habe, nun ist die Liste (aus logischen Gründen) in der Reihenfolge angeordnet, in dem die einzelnen Elemente eingefügt wurden.

Der neue Quelltext ist wieder oben. Ich habe, da ja nun schon einige Änderungen vorgenommen wurden, auch das Projekt im Anhang aktualisiert. Tut mir Leid wegen der Umstände.

del1312 · Beiträge: 190

hey kein prob, musst dich dafür doch nicht entschuldigen, find das super das du es noch verbesserst

) bin grad dabei mir das tool so zu schreiben wie ich es brauch. mach jetzt erstmal weiter und schau mir dann morgen mal die änderungen an. das ist schon ganz schön unübersichtlich für mich geworden, muss das erstmal alles auseinanderpflücken und schauen wie das überhaupt alles so funzt

)

del1312 · Beiträge: 190

hab jetzt aber nen prob mit der gruppen.txt. du hast das ja jetzt so gebaut, das die gruppen folgendermaßen aufgebaut sind:

aa::001: ....
ab::002: ....

die die stelle wo die zahlen 001 und 002 stehen, sind aber nicht in der reihenfolge sonder haben
zahlen quer durchs gemüsebeet. dadurch schreibt er jetzt ne fehler in die gruppen.txt.

so wie du das im download hast funktionier es aber sobald du mal ne zeile reinschreibst:

ac::765: ....
ad::876: ....

und im programm dann diesen gruppen mal user zu schreibst dann stehen da plötzlich falsche zeichen in der zeile wie z.b

ad::876:5: ....

kannst du mir das bitte nochmal ändern?

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme