Einige nützliche Funktionen

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

hallo,
hier sind einige nützliche funktionen die ich gesammelt, bzw. geschrieben habe. evtl. helfen sie ja euch:
einfach in einer datei namesn Tools.pas reinkopieren(vorher anlegen*G*)
Vielen Dank: MathiasSimmack, deine vorschläge sind übernohmen, hast du evtl, noch welche ?
ich habe drei proceduren hinzugeüfgt: ReadDir, CopyFiles, isIniSek

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:
320:
321:
322:
323:
324:
325:

unit Tools;

interface
  uses Sysutils,inifiles, Windows, Classes;

// -- String verarbeitung -- 

  // gibt die Richtungs tasten(Lings, Rechts, Oben, Unten) als namen zurück
  function GetKeyName(Key:Word):String;

  // Zählt die vorkommen von einem Bestimmten zeichen
  function NumToken(aString: String; SepChar: Char):Byte;

  // gibt einen vorkommen als string zurück
  function GetToken(aString: String; SepChar: Char; TokenNum: Byte):String;

  // Löscht einen tocken in einem String und gibt dann den neuen string zurück
  function DelToken(aString,delstr: String):String;

   // Ändert einen tocken in einem String und gibt dann den neuen string zurück
  function SetToken(OldString, NewText:String; SeptChar:Char; TokenNr:Integer):String;
  
  // gint das Exe verzeichnis von deiner anwendung zurück
  function GetExeDir:String;

// -- Sonstige funktionen -- 

  // Schreibt in ein RichEdit in der angeben pos(Funktiniert auch bei memo: muss man nur anpassen)
  procedure str_into_RichEdit(Liste1215:TStringList;Insert_Text:string; line:integer; position:integer);

// -- Datei funktionen --

  //  Liefert die genaue datei größe als Bytes
  function GetFileSize(const AFileName: String): Integer;

  // Prüft ob in bestimmtens zeichem im im Dateinamen vorhanden ist
  function IsChar(const AFilename: string; ch: string): String; overload;

  // Prüft ob in bestimmtens zeichem im im Dateinamen vorhanden ist
  function IsChar(const AFilename: string; ch: char): String; overload;

  // Prüft ob in den Dateinamen ein ein \ ist und wenn nicht, fügt er es hinzu
  function CheckBackSlash(const AFilename: String): String;
  
  // List ein verzeichnis in eine TStringList ein
  function ReadDir(Path, Mask:string; ShowPath: boolean): TStringlist;

  // Gibt einen folgendes zurück(als beispiel: 18 KB
  function FormatFileSize(Size: INT64): string;

  // Ließt einen String aus einer ini datei
  function  ReadIni(FileName,Sektion,ident,fehler:String) :String;

  // Schreibt einen String in eine Ini Datei
  procedure WriteIni(FileName,Sektion,ident,WriteText:String);

  // prüft ob es eine bestimmte ini Sektion schon gibt oder nicht
  function isIniSek(FileName:TFileName; Sek:String):boolean;

  // Copiert mehre Dateien(von Qull) ins Ziel Verzeichnis
  procedure CopyFiles(Qulle, Ziel: TFileName; M:String);


implementation

uses Unit1;


function GetFileSize(const AFileName: String): Integer;
var
  F: TStream;
begin
  Result:=-1;
  F:=TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
  Result := F.Size;
  f.Free;
end;

function IsChar(const AFilename: string; ch: char): String;
begin  
  if(length(AFilename) > 0) and (AFileName[length(AFilename)] <> ch) then  
    Result := AFilename + ch  
  else  
    Result := AFilename;  
end;  

function IsChar(const AFilename: string; ch: string): String;
begin  
  if(length(AFilename) > 0) and  
    (pos(ch,AFilename) = length(AFilename) - length(ch)) then  
  Result := AFilename + ch  
    else Result := AFilename;  
end;

function CheckBackSlash(const AFilename: String): String;  
begin  
  Result   := IsChar(AFileName,'\');  
end;

function FormatFileSize(Size: INT64): string;
var 
  Byte, Ausgabe: string;
begin
  Byte := ' Byte';
  result       := IntToStr(Size);

  if Size >= 10737418240 then
  begin
    Ausgabe := CurrToStrF((Size / (1024 * 1024 * 1024)), ffNumber, 2);
    Byte := ' GB';
  end
  else
  if Size >= 1048576 then
  begin
    Ausgabe := CurrToStrF((Size / (1024 * 1024)), ffNumber, 2);
    Byte := ' MB';
  end
  else
  begin
    if Size >= 1024 then
    begin
      Ausgabe := CurrToStrF((Size / 1024), ffNumber, 2);
      Byte := ' KB';
    end
    else
      Ausgabe := IntToStr(Size);
  end;
  result := Ausgabe + Byte;
end;

function GetKeyName(Key:Word):String;
begin
  if Key = VK_LEFT then result:='Pfeil Taste Links';
  if Key = VK_RIGHT then result:='Pfeil Taste Rechts';
  if Key = VK_UP then result:='Pfeil Taste Oben';
  if Key = VK_Down then result:='Pfeil Taste Unten';  
end;

procedure str_into_RichEdit(Liste1215:TStringList;Insert_Text:string; line:integer; position:integer);
var
  h : integer;
begin

with Liste1215 do begin 
  for h := Count to line-1 do 
    Add(''); 

  for h := length(Strings[line-1]) to position do 
    Strings[line-1] := Strings[line-1] + ' '; 

  Strings[line-1] := copy(Strings[line-1], 1, position-1) + Insert_Text + copy(Strings[line-1], position+1, length(Strings[line-1])); 

end;end;

function DelToken(aString,delstr: String):String;
begin
  result:=StringReplace(aString,delstr,'',[]);
end;

function ReadIni(FileName,Sektion,ident,fehler:String):String;
var
  inifile1:TIniFile;
begin
  if FileExists(FileName) = True then begin
    IniFile1:=TiniFile.Create(FileName);
    if IniFile1.ValueExists(Sektion,ident) = True then
      Result:=Inifile1.ReadString(Sektion,ident,fehler)
    else
      result:='';
  end
  else
    result:='';

  IniFile1.Free;
end;

procedure WriteIni(FileName,Sektion,ident,WriteText:String);
var
  inifile:TInifile;
begin
  IniFile:=TiniFile.Create(FileName);
  Inifile.WriteString(Sektion,ident,WriteText);
  inifile.Free;
end;

function GetExeDir:String;
begin
  result:=ExtractFilePath(ParamStr(0));
end;

function NumToken(aString: String; SepChar: Char):Byte;
var
   RChar     : Char;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
  if SepChar = '#' then begin
    RChar := '*'
  end
  else begin
    RChar := '#'
  end;
   StrLen := Length(aString);
   TNum   := 0;
   TEnd   := StrLen;
  while TEnd <> 0 do  begin
    Inc(TNum);
    TEnd := Pos(SepChar,aString);
    if TEnd <> 0 then begin
      aString[TEnd] := RChar;
    end;
  end;
  Result := TNum;
end;

function GetToken(aString: String; SepChar: Char; TokenNum: Byte):String;
var
   Token     : String;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
  StrLen := Length(aString);
  TNum   := 1;
  TEnd   := StrLen;
  while ((TNum <= TokenNum) and (TEnd <> 0)) do begin
    TEnd := Pos(SepChar,aString);
    if TEnd <> 0 then begin
      Token := Copy(aString,1,TEnd-1);
      Delete(aString,1,TEnd);
      Inc(TNum);
    end else Token := aString;
  end;

  if TNum >= TokenNum then
    Result := Token
  else begin
    Result := Format('Fehler: Tokennummer (%s) ist größer als token !',[aString]);
    MessageBox(0,pchar(Result),nil,MB_OK or MB_ICONEXCLAMATION);
  end;
end;

function SetToken(OldString, NewText:String; SeptChar:Char; TokenNr:Integer):String;
var
  ende,x,SeptCount:Integer;
  str:String;
begin
  if TokenNr > NumToken(OldString,SeptChar) then begin
    result:='1';
    exit;
  end;

  SeptCount:=0; str:='';

  for x:=0 to Length(OldString) do begin
    if OldString[x] = SeptChar then inc(SeptCount);
    if SeptCount = TokenNr-1 then begin
      str:=OldString;
      ende:=Length( GetToken(OldString,SeptChar,TokenNr));
      Delete(str, x+1, ende);
      insert(NewText,str,x+1);
      result:=str;
      Break;
    end;
  end;
end;

function ReadDir(Path, Mask:string; ShowPath: boolean): TStringlist;
var
  SL: TStringList;
  SRec: TSearchRec;  
begin
  SL := TStringList.Create;
  FindFirst(Path + Mask + #0, not faDirectory, SRec);
  if ShowPath then
    SL.Add(Path + SRec.Name)
  else
    SL.Add(SRec.Name);
  while FindNext(SRec) = 0 do
    if ShowPath then
      SL.Add(Path + SRec.Name)
    else
      SL.Add(SRec.Name);

//  FindClose(SRec);
  Result := SL;
end;

procedure CopyFiles(Qulle, Ziel: TFileName; M:String);
var
  CopyF:TStringList;
  i:Integer;
  CP1,Cp2:TFileStream;
begin
  CopyF:=TStringList.Create; 

  // Erstellt eine Verzeicnis Liste
  CopyF:=ReadDir(Qulle, M, True);

  for i:=0 to CopyF.Count-1 do begin
    try
      CP1:=TFileStream.Create(CopyF.Strings[i],fmOpenRead  );
      CP2:=TFileStream.Create(ExtractFileName(CopyF.Strings[i]),fmOpenRead)
    finally
      CP1.Free;
      CP2.Free;
    end;
  end;

  CopyF.Free;
end;

function isIniSek(FileName:TFileName; Sek:String):boolean;
var
  inifile:TInifile;
begin
  IniFile:=TiniFile.Create(FileName);
  result:=IniFile.SectionExists(Sek);
  inifile.Free;
end;

end.

_________________
MFG
Michael Springwald, "kann kein englisch...."

Tino · Beiträge: 9839 Erhaltene Danke: 45 Windows 8.1 Delphi XE4

Hallo mimi,

danke für deinen Beitrag. Beachte bitte das erste Posting in dieser Sparte. Vor allem die folgenden beiden Punkte:

Beschreib die Unit in einigen Sätzen damit der Leser weiß um was es geht
Die Unit muss dokumentiert sein

Bitte überarbeite deshalb Deinen ersten Beitrag oben. Danke!

Gruß
Tino

Ehemaliges Mitglied Erhaltene Danke: 1

Wie im anderen Beitrag versprochen, hier ein kleiner Verbesserungsvorschlag -
Es geht mir dabei um diese beiden Funktionen:

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:

function CheckBackSlash(const AFilename: String): String;
begin
  if Length(AFilename)=0 then
    begin
      Result:=AFilename;
      Exit;
    end;

  if AFilename[Length(AFilename)]<>'\' then
    Result:=AFilename+'\'
  else
    Result:=AFilename;
end;

function isChar(AFilename,Char1:String): String;
begin
  if Length(AFilename)=0 then
    begin
      Result:=AFilename;
      Exit;
    end;

  if AFilename[Length(AFilename)]<>char1 then
    Result:=AFilename+char1
  else
    Result:=AFilename;
end;

Der erste Knackpunkt: Die Funktion "IsChar" steht nicht im interface-Teil und ist somit gar nicht nutzbar. Eine interne Funktion ist es aber auch nicht, weil sie von keiner anderen gebraucht wird.

Aber das kann man ändern -
Die erste Funktion prüft ob ein Backslash am Ende ist und hängt ggf. eins an. Die zweite Funktion soll dem Anschein nach prüfen ob ein beliebiges Zeichen vorhanden ist und es ggf. anhängen. "dem Anschein nach" bedeutet für mich, dass es Blödsinn ist, "Char1" als String zu deklarieren und den Vergleich

markieren

Delphi-Quelltext

1:	if AFilename[Length(AFilename)]<>char1 then

zu benutzen. Was passiert wohl in diesem Fall:

markieren

Delphi-Quelltext

1:
2:
3:

ShowMessage(
  isChar('c:\LastCrap\Test.bla','bla')
);

Richtig: Obwohl "bla" schon vorhanden ist, versagt die Funktion und hängt es noch mal an. Wie dem auch sei, beide Funktionen machen prinzipiell das gleiche, nur dass eben "CheckBackSlash" auf ein bestimmtes Zeichen festgelegt ist. Also warum nicht so:

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:

//
// im interface als "overload" deklarieren
//
function IsChar(const AFilename: string; ch: char): String;
begin
  if(length(AFilename) > 0) and (AFileName[length(AFilename)] <> ch) then
    Result := AFilename + ch
  else
    Result := AFilename;
end;

//
// im interface als "overload" deklarieren
//
function IsChar(const AFilename: string; ch: string): String;
begin
  if(length(AFilename) > 0) and
    (pos(ch,AFilename) = length(AFilename) - length(ch)) then
  Result := AFilename + ch
    else Result := AFilename;
end;

function CheckBackSlash(const AFilename: String): String;
begin
  Result   := IsChar(AFileName,'\');
end;

"CheckBackslash" benutzt intern jetzt "IsChar", und außerdem hast du zwei (überladene) Varianten von "IsChar", so dass du sowohl auf CHARs als auch auf Strings prüfen kannst.

Die folgenden Units können sofort rausfliegen:

markieren

Delphi-Quelltext

1:	Messages, Graphics, Controls, StdCtrls, ExtCtrls

Die Dialogs-Unit kann normalerweise auch raus, weil sie nur wg. "MessageDlg" eingebunden sein muss. Nimmst du stattdessen "MessageBox" (Windows-Unit), erzielst du das selbe Ergebnis. A pro pos: Schau dir die betreffenden zwei Zeilen mal an

markieren

Delphi-Quelltext

1:
2:

MessageDlg('Fehler: Tokennummer(' + aString + ' )ist größer als token !',mtError, [mbok], 0);
Result := 'Fehler: Tokennummer(' + aString + ' )ist größer als token !';

Ich frage mich, warum du den gleichen String zweimal benutzt? So rum ist es effizienter

markieren

Delphi-Quelltext

1:
2:

Result := Format('Fehler: Tokennummer (%s) ist größer als token !',[aString]);
MessageBox(0,pchar(Result),nil,MB_OK or MB_ICONEXCLAMATION);

und die Dialogs-Unit kann auch noch weg.

Und wenn du "*Token"-Funktionen hier brauchst und auch in deinem eigenen Speicherformat, warum deklarierst du dann nicht einfach in der Tools2-Unit die Tools-Unit?

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

naja, ich war wohl damls nicht auf den stand auf dem ich heute bin *G* aber danke, für deine verbesserungs vorschläge *G*

_________________
MFG
Michael Springwald, "kann kein englisch...."

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

nochmal:
vielen dank für deine vorschläge ich werde sie übernehmen !!!

_________________
MFG
Michael Springwald, "kann kein englisch...."

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme