[
Code: Alles auswählen
myfiles:=Findallfiles(SourceDir,'',true);Falls das jemand ausprobieren möchte: Hier ist der Quelltext. Ist ja nur die Hauptunit. Die betreffende Codezeile ist 446. Damit es funktioniert muss man noch unter Projekt -> Projekteinstellungen die LCL als Package einbinden. In der Vorschau ist unten bei DirSep der Backspace kaputt, falls das mit dem Copy und pasten nicht funktioniert. Achso man muss als erstes Argument einen Ordnerpfad übergeben und als zweiten den Pfad zu einem Textfile, in dem folgendes steht:
Code: Alles auswählen
23.02.1975 12:00:00 240
23.02.2075 12:34:56 140Code: Alles auswählen
program syncnorm;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp,
{ you can add units after this }
fileutil,dateutils;
type
TIntarray = array of integer;
TDoublearray = array of double;
TStringarray = array of string;
TEnergy = (Ebin,Ekin);
TPlace = (Berlin,Hamburg);
TTimePoint = record
time:TDateTime;
intensity:double;
end;
TTimePeriod = array[0..1] of TTimePoint;
TTimes = array of TTimePeriod;
{ TSpektraNormalizer }
TSpektraNormalizer = class(TCustomApplication)
protected
procedure DoRun; override;
public
timearray:TTimes;
dorename:boolean;
dirsep:char;
basepath,newbasepath:string;
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
function ReadTimeFile(filename: string):boolean;
function ProcessDirectory(relpathname: string):boolean;
procedure provideDestDir(relpath:string);
function ProcessFile(relpathname:string):boolean;
function calculatenormfaktor(datetime:TDatetime;sweeps:integer):double;
procedure normalize(var yarray:TDoublearray;normfaktor:double);
end;
{ TSpektraNormalizer }
//Falls term nicht in line vorhanden ist ist das Ergebnis Null
function strcmp(line1,term:string):integer;
var i,a:integer;identical:boolean;line:string;
begin
line:=lowercase(line1);
result:=-1;
for i:=1 to length(line)-length(term)+1 do
begin
if line[i]=term[1] then
begin
//nur vorläufig
identical:=true;
for a:=2 to length(term) do
begin
if line[i-1+a]<>term[a] then
begin
identical:=false;
break;
end;
end;
if identical then
begin
result:=i;
break;
end;
end;
end;
end;
function parseline(line:string;var xwert,ywert:double):boolean;
var i,a,beginfirst,endfirst,beginsecond,endsecond:integer;
begin
//Nummer neun ist das Tabulatorsteuerzeichen
result:=false;
beginfirst:=1;
beginsecond:=1;
for i:=1 to length(line) do
begin
if not (line[i] in [' ',#9]) then
begin
beginfirst:=i;
break;
end;
end;
//first number
for i:=beginfirst+1 to length(line) do
begin
//E für exponentielle Schreibweise
if not (line[i] in ['0'..'9','.',',','-','+','E',' ',#9]) then
begin
//bedeutet diese Zeile beinhaltet nicht nur Messdaten
result:=false;
exit;
end;
if line[i] in [' ',#9] then
begin
endfirst:=i;
xwert:=strtofloat(copy(line,beginfirst,endfirst-beginfirst));
//und den nächsten Anfag finden
for a:=i+1 to length(line) do
begin
if not(line[a] in [' ',#9]) then
begin
beginsecond:=a;
break;
end;
end;
break;
end;
end;
if beginsecond=length(line) then
begin
ywert:=strtofloat(copy(line,beginsecond,1));
result:=true;
exit;
end;
//second number
for i:=beginsecond+1 to length(line) do
begin
//E für exponentielle Schreibweise
if not (line[i] in ['0'..'9','.',',','-','+','E',' ',#9]) then
begin
result:=false;
exit;
end;
if (line[i] in [' ',#9]) or (i=length(line)) then
begin
endsecond:=i;
if i=length(line) then
begin
inc(endsecond);
end;
ywert:=strtofloat(copy(line,beginsecond,endsecond-beginsecond));
//nur wenn beide Zahlen gefunden wurden wird die Funktion true
result:=true;
break;
end;
end;
end;
function assumesize(filename:string):integer;
begin
//muss noch dynamisch anhand der Dateigröße geschätzt werden
result:=round(Filesize(filename)/8)+1; //also jede Zeile hat im Mittel acht ascii Zeichen
end;
function WriteFile(filename:string;xarray,yarray:TDoublearray):boolean;
var i:integer;datfile:textfile;
begin
result:=false;
try
assignfile(datfile,filename); //datei öffnen, dir = dateipfad
rewrite(datfile); //'f' zurücksetzen
for i:=0 to length(xarray)-1 do
begin
writeln(datfile,xarray[i]:7:6,' ',yarray[i]:7:6); //zeile auslesen und in 'zeile' speichern
end;
result:=true;//falls eine Excpetion dann direkt zu finally ohne true zu werden
finally
//Rewrite(TextDatei); //Datei erstellen
closefile(datfile);
end;
end;
function TSpektranormalizer.ReadTimeFile(filename: string):boolean;
var datfile:Textfile;worktext,olddateformat,oldtimeformat:string;
i,a,assumedsize,valuepair:integer;
intensity:double;datetime:TDateTime;
begin
if filename='' then
begin
writeln('No Time File has been passed');
Halt;
end;
olddateformat:=shortdateformat;
oldtimeformat:=longtimeformat;
shortdateformat:='dd.mm.yyyy';
longtimeformat:='hh:nn:ss';
result:=false;
try
assignfile(datfile,filename); //datei öffnen, dir = dateipfad
reset(datfile); //'f' zurücksetzen
//Arraygröße schätzen und setzen
assumedsize:=assumesize(filename);
setlength(timearray,assumedsize);
i:=0;
a:=0;
while not eof(datfile) do //weil das dokument ncoh nciht zu ende ist tue
begin
inc(a);
ReadLn(datfile,worktext); //zeile auslesen und in 'zeile' speichern
i:=length(worktext)-1;
//zweites Argument Zeit
while i>=1 do
begin
if worktext[i]=' ' then
begin
intensity:=strtofloat(copy(worktext,i+1,length(worktext)-i));
dec(i);
while worktext[i]=' ' do
begin
dec(i);
end;
break;
end;
dec(i);
end;
//erstes Argument ist im Rest
datetime:=strtodatetime(copy(worktext,1,i));
valuepair:=a mod 2;
if valuepair<>0 then
begin
timearray[valuepair-1][1].time:=datetime;
timearray[valuepair-1][1].intensity:=intensity;
end else begin
timearray[valuepair-1][0].time:=datetime;
timearray[valuepair-1][0].intensity:=intensity;
end;
end;
setlength(timearray,valuepair);
result:=true;
finally
closefile(datfile);
shortdateformat:=olddateformat;
longtimeformat:=oldtimeformat;
end;
end;
function ReadFile(filename: string;var xarray,yarray:TDoublearray;datetime:TDateTime;sweeps:integer;regionname:string):boolean;
var datfile:Textfile;worktext:string;i,assumedsize:integer;
date:TDatetime;time:TDatetime;
begin
result:=false;
try
assignfile(datfile,filename); //datei öffnen, dir = dateipfad
reset(datfile); //'f' zurücksetzen
//Arraygröße schätzen und setzen
assumedsize:=assumesize(filename);
setlength(xarray,assumedsize);
setlength(yarray,assumedsize);
i:=0;
while not eof(datfile) do //weil das dokument ncoh nciht zu ende ist tue
begin
ReadLn(datfile,worktext); //zeile auslesen und in 'zeile' speichern
if strcmp(worktext,'date')<>-1 then
begin
date:=strtodate(copy(worktext,6,length(worktext)-5));
end else
if strcmp(worktext,'time')<>-1 then
begin
time:=strtotime(copy(worktext,6,length(worktext)-5));
end else
if strcmp(worktext,'region name')<>-1 then
begin
regionname:=copy(worktext,13,length(worktext)-12);
end else
if strcmp(worktext,'number of sweeps')<>-1 then
begin
sweeps:=strtoint(copy(worktext,18,length(worktext)-17));
break;
end;
end;
datetime:=date+time;
i:=0;
while not eof(datfile) do //weil das dokument ncoh nciht zu ende ist tue
begin
ReadLn(datfile,worktext); //zeile auslesen und in 'zeile' speichern
if parseline(worktext,xarray[i],yarray[i]) then
begin
inc(i);
end else begin
end;
end;
setlength(xarray,i);
setlength(yarray,i);
result:=true;
finally
closefile(datfile);
end;
end;
procedure TSpektraNormalizer.provideDestDir(relpath:string);
var a:integer;
begin
//Schauen ob relpath noch ORdnerteile enthält und diese ggf anlegen
for a:=length(relpath) downto 1 do
begin
if relpath[a]=DirSep then
begin
if not(DirectoryExists(newbasepath+copy(relpath,1,a))) then
begin
provideDestDir(copy(relpath,1,a-1));
CreateDirUTF8(newbasepath+copy(relpath,1,a));
end;
break;
end;
end;
end;
procedure appendregionname(var filename,regionname:string);
var i:integer;
begin
for i:=length(filename) downto 1 do
begin
if filename[i]='.' then
begin
insert(regionname,filename,i-1);
exit;
end;
end;
end;
function TSpektraNormalizer.calculatenormfaktor(datetime:TDatetime;sweeps:integer):double;
begin
end;
function TSpektraNormalizer.ProcessFile(relpathname:string):boolean;
var DestFile,SourceFile:string;
xarray,yarray:TDoublearray;
normfaktor:double;
successread,successwrite:boolean;
datetime:TDatetime;regionname:string;sweeps:integer;
begin
DestFile:=newbasepath+relpathname;
SourceFile:=basepath+relpathname;
//entry = readdir(VZ);
//if (entry != NULL) {
//lowercase(entry->d_name);
//secogefunden = (char*)strstr(entry->d_name,suchseco);
//datgefunden = (char*) strstr(entry->d_name,suchdat);
// if ((secogefunden != NULL) && (datgefunden != NULL)) {
writeln('Prozessiere Datfile mit Namen: ');
writeln(SourceFile);
//Länge herausfinden
//stat(origname, &attribut);
//lines=attribut.st_size*0.2;
successread:=ReadFile(SourceFile,xarray,yarray,datetime,sweeps,regionname);
if dorename then
begin
appendregionname(destfile,regionname);
end;
normfaktor:=calculatenormfaktor(datetime,sweeps);
normalize(yarray,normfaktor);
successwrite:=WriteFile(DestFile,xarray,yarray);
if (successread and successwrite) then
begin
writeln('Die Datei wurde erfolgreich verarbeitet');
writeln('');
end else begin
writeln('Die Datei wurde NICHT erfolgreich verarbeitet');
writeln('');
end;
end;
procedure expandsearchmask(var mask:string;var searchterms:TStringarray);
var i,ending:integer;wildcard:string;
begin
//schon einmal die Endwildcard anhängen
wildcard:='*';
if mask[length(mask)]<>'*' then
begin
mask:=mask+'*';
end;
ending:=length(mask);
for i:=length(mask) downto 1 do
begin
if mask[i]=';' then
begin
setlength(searchterms,length(searchterms)+1);
searchterms[length(searchterms)-1]:=copy(mask,i+1,ending-i-1);
ending:=i;
insert(wildcard,mask,i+1);
insert(wildcard,mask,i);
end;
end;
setlength(searchterms,length(searchterms)+1);
searchterms[length(searchterms)-1]:=copy(mask,1,ending-1);
insert(wildcard,mask,1);
end;
function TSpektraNormalizer.ProcessDirectory(relpathname: string):boolean;
var SourceDir,DestDir,currentfile,relpath,purefilename,filesearchmask,mask:string;myfiles:TStringlist;
successread,successwrite,pathisdestination,masknotmatched,dorecursive:boolean;
i,a,test:integer;
searchterms:TStringarray;
begin
//SourceDir:=opendir(pathname);
DestDir:=newbasepath+relpathname;
SourceDir:=basepath+relpathname;
//hier werden die direkt die Dateien rekursiv oder nicht gesucht.
//mask:='.txt;.dat';
//expandsearchmask(mask,searchterms);
//myfiles:=Findallfiles('C:\test\','',true);
//dorecursive:=true;
myfiles:=Findallfiles(SourceDir,'',true);//letzter Parameter ist subdirs
//Sicherhaitsabfragen
if not(CreateDirUTF8(DestDir)) then
begin
writeln('Warning: The Destination Folder ',relpathname,' does exist.');
writeln('Files will be overwritten');
end;
if not (Directoryiswritable(DestDir)) then
begin
writeln('The Folder is not writable');
halt;
end;
//Eigentliche Schleife (nur ein File wir im Hauptprogramm abgefangen
//hier nur Unterscheidung zwishcen rekursiv oder nicht
writeln;
writeln;
for i:=0 to myfiles.count-1 do
begin
pathisdestination:=false;
currentfile:=myfiles.Strings[i];
relpath:=createRelativePath(currentfile,basepath);
//Im ersten Teil der relativen Pfadangabe nach dem Zielordner suchen
//Da ja die Zieldateien nicht auch noch verarbeitet werden sollen
//Endlosschleife
for a:=1 to length(relpath) do
begin
if relpath[a]=DirSep then
begin
if strcmp(copy(relpath,1,a-1),'corr')<>-1 then
begin
pathisdestination:=true;
end;
break;
end;
end;
if pathisdestination then
begin
continue;
end;
Purefilename:=ExtractFileNameOnly(relpath);
masknotmatched:=false;
for a:=0 to length(searchterms)-1 do
begin
if strcmp(Purefilename,searchterms[a])=-1 then
begin
masknotmatched:=true;
break;
end;
end;
if masknotmatched then
begin
continue;
end;
provideDestDir(relpath);
processfile(relpath);
end;
end;
procedure TSpektranormalizer.normalize(var yarray:TDoublearray;normfaktor:double);
var i:integer;skalefaktor:double;
begin
if normfaktor=0 then
begin
writeln('Achtung ein falscher Normfaktor wurde übergeben');
end else begin
skalefaktor:=1/normfaktor;
for i:=0 to length(yarray)-1 do
begin
yarray[i]:=yarray[i]*skalefaktor;
end;
end;
end;
procedure TSpektraNormalizer.DoRun;
var
ErrorMsg,MyShortOptions,teststring,relpathname,timefilepath: String;
parametercount,argumentcount,optioncount:integer;
const
MyLongOptions:array [0..1] of string = ('help','rename');
begin
MyShortOptions:='hr';//oswE:F:V:';
self.CaseSensitiveOptions:=false;
// quick check parameters
ErrorMsg:=CheckOptions(MyShortOptions,MyLongOptions);
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Halt;
end;
writeln(getparams(0));
parametercount:=GetParamCount;
optioncount:=0;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
inc(optioncount);
Halt;
end;
if HasOption('r','rename') then
begin
inc(optioncount);
end;
dorename:=HasOption('rename');
{ Argumente parsen vorher waren es Optionen }
argumentcount:=parametercount-optioncount;
if argumentcount=0 then
begin
halt;
end else begin
if argumentcount>2 then
begin
writeln('Too many arguments have been passed!');
halt;
end else begin
basepath:=Getparams(optioncount+1);
if not(DirectoryExists(basepath)) then
begin
writeln('Es wurde kein Verzeichnis übergeben');
halt;
end else begin
writeln(basepath);
//Add Backspace if necessary
if basepath[length(basepath)]<>Dirsep then
begin
basepath:=basepath+DirSep;
end;
newbasepath:=basepath+'corr'+DirSep;
if argumentcount=2 then
begin
timefilepath:=lowercase(Getparams(optioncount+2));
end else begin
writeln('No file with pairs of time intensity values has been passed');
end;
end;
end;
end;
if not(Readtimefile(timefilepath)) then
begin
writeln('The File with time <-> intensity mapping is invalid');
end;
{ add your program here }
writeln;
writeln;
processDirectory('');
// stop program loop
Terminate;
end;
constructor TSpektraNormalizer.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
DirSep:='\';
end;
destructor TSpektraNormalizer.Destroy;
begin
inherited Destroy;
end;
procedure TSpektraNormalizer.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TSpektraNormalizer;
begin
Application:=TSpektraNormalizer.Create(nil);
Application.Title:='SpektraNormalizer';
Application.Run;
Application.Free;
end.
Verein
Links
Suche