MODULE InfoCheckFilenames;
	(* Helmut Zinn -  *)

	(*  "StdCmds.OpenToolDialog('Info/Rsrc/CheckFilenames1', 'Check Filenames')" *)

	IMPORT 
		Dialog, (* DosFiles, DosSort, *) Files, Fonts, InfoCmds, InfoTrans, PacDirChoose, Ports, 
		Services, Strings, StdCmds, StdLinks, StdLog, TboxTimer, TextModels, WinApi;

	CONST
		n1 = 64;
		n2 = 260;
		speed = 50;
		keep = 8;
		linkcommand = 'InfoCmds.Start'; (* Alternativ: linkcommand = 'LibMisc.ShellExecute'; *)
		underline = FALSE;

	TYPE
		Node = POINTER TO RECORD
			root: Files.Locator;
			locs: Files.LocInfo;
			files: Files.FileInfo;
			n: LONGINT;
			len: INTEGER;
			state: INTEGER;
			last: Node;
		END;

		Action = POINTER TO RECORD (Services.Action)
			pos: Node;
		END;

	VAR
		dialog*: RECORD
			source*: ARRAY n2 + 1 OF CHAR;
			path-: ARRAY n2 + 1 OF CHAR;
			oldname-: Files.Name;
			newname*: Files.Name;

			include*: BOOLEAN;
			interaktive*: BOOLEAN;
			trapOnError*: BOOLEAN;
			testOnly*: BOOLEAN;	(* test run only, no change done *)
		
			renameLongNames*: BOOLEAN;	(* cut long names to its bound *)
			deleteEmptyFolders*: BOOLEAN;	(* delete directories while it is empty *)
			replaceSpecialChar*: BOOLEAN;	(* replace blanks & national language character *)
			toLowercase*: BOOLEAN;	(* convert filename to lower case *)

			cntLocations-: LONGINT; 	(* total number of directories *)
			cntFiles-: LONGINT; 	 (* total number of files *)
			cntBytes-: LONGINT; 	 (* total number of bytes used *)

			cntToolong-: LONGINT; 	(* number of files where the filename is too long *)
			cntToodeep-: LONGINT; 	(* number of files where the path is too long *)
			cntEmpty-: LONGINT; 	(* number of files where the directory is empty *)
			cntSpecialChar-: LONGINT; 	(* number of files where the its name has special characters *)

			cntRenamed-: LONGINT; 	(* number of files renamed *)
			cntDeleted-: LONGINT; 	(* number of directories deleted *)
			cntSkip-: LONGINT; 	(* operation not done *)
			cntError-: LONGINT; 	(* file already exist or write protected *)
		END;

		a: Action;
		task: INTEGER;
		running, waiting: BOOLEAN;

	PROCEDURE ShowResError (res: INTEGER);
	BEGIN
		StdLog.String('==> Error: ');
		CASE res OF
		| 1: StdLog.String('invalid parameter (name or locator)');
		| 2: StdLog.String('location or file not found');
		| 3: StdLog.String('file already exists');
		| 4: StdLog.String('write-protection');
		| 5: StdLog.String('io error');
		| 6: StdLog.String('access denied');
		| 7: StdLog.String('illegal file type');
		| 8: StdLog.String('cancelled');
		ELSE StdLog.Int(res);
		END;
		StdLog.Ln;
		StdLog.Open;
		IF dialog.trapOnError THEN ASSERT(res = 0) END;
	END ShowResError;

	 (* Choose folder to proof *)

	PROCEDURE FixSrcRoot* (IN path: Files.Name);
	BEGIN
		dialog.source := path$; dialog.path := path$; dialog.oldname := ''; dialog.newname := '';
		Dialog.Update(dialog);
	END FixSrcRoot;

	PROCEDURE BrowseSource*;
	BEGIN
		PacDirChoose.Choose(FixSrcRoot);
	END BrowseSource;

	 (* Outputs to Log window *)

	PROCEDURE WriteMapString (IN note: ARRAY OF CHAR);
	VAR
		msg: ARRAY 256 OF CHAR;
	BEGIN
		Dialog.MapString(note, msg); StdLog.String(msg$);
	END WriteMapString;

	PROCEDURE WriteLink (IN path: ARRAY OF CHAR);
	VAR
		attr: TextModels.Attributes;
		beg, end: INTEGER;
		cmd, msg: ARRAY n2+32 OF CHAR;
	BEGIN
		cmd := linkcommand + "('" + path$ + "')";
		msg := path$;
		StdLog.View(StdLinks.dir.NewLink(cmd));
		StdLog.String(msg);
		end := StdLog.text.Length(); beg := end - LEN(msg$);
		NEW(attr); 
		attr.InitFromProp(StdLog.text.Prop(beg, end));
		attr := TextModels.NewColor(attr, Ports.blue);
		IF underline THEN attr := TextModels.NewStyle(attr, {Fonts.underline}) END;
		StdLog.text.SetAttr(beg, end, attr);
		StdLog.View(StdLinks.dir.NewLink(""));
	END WriteLink;

	 (* Change / remove file / folder names *)

	PROCEDURE Exist (IN path: ARRAY OF CHAR; IN old: Files.Name): BOOLEAN;
		VAR 
			loc: Files.Locator;
			file: Files.File;
	BEGIN
		loc := Files.dir.This(path$);
		file := Files.dir.Old(loc, old, Files.shared);		
		IF file = NIL THEN RETURN FALSE ELSE RETURN TRUE END;
	END Exist;

	PROCEDURE RenameFile (IN path: ARRAY OF CHAR; IN old, new: Files.Name);
		VAR 
			loc: Files.Locator;
	BEGIN
		(* Can't rename if path + oldname is longer than 260 characters. File-IO-Error 2: location or file not found. *)
		StdLog.String('> Rename to: '); WriteLink(path$); StdLog.String(new$); StdLog.Ln;
		loc := Files.dir.This(path);
		Files.dir.Rename(loc, old, new, Files.ask);		
		IF loc.res = 0 THEN
			INC(dialog.cntRenamed) 
		ELSE 
			INC(dialog.cntError); 
			StdLog.String('<<< File-IO-Error '); StdLog.Int(loc.res); StdLog.String(' >>>'); StdLog.Ln; 
			ShowResError(loc.res);
		END;
	END RenameFile;

	PROCEDURE DeleteFile (IN path: ARRAY OF CHAR; IN old: Files.Name);
		VAR 
			loc: Files.Locator;
	BEGIN
		StdLog.String('> Delete file: '); WriteLink(path$); StdLog.String(old$); StdLog.Ln;
		loc := Files.dir.This(path$);
		Files.dir.Delete(loc, old$);
		IF loc.res = 0 THEN
			INC(dialog.cntDeleted) 
		ELSE 
			INC(dialog.cntError); 
			StdLog.String('<<< File-IO-Error '); StdLog.Int(loc.res); StdLog.String(' >>>'); StdLog.Ln; 
			ShowResError(loc.res);
		END;
	END DeleteFile;

	PROCEDURE DeleteFolder (IN path: ARRAY OF CHAR);
		VAR 
			res: INTEGER;
	BEGIN
		StdLog.String('> Delete folder: '); WriteLink(path$); StdLog.Ln;
		res := WinApi.RemoveDirectoryW(path);
		IF res = 1 THEN
			INC(dialog.cntDeleted) 
		ELSE 
			INC(dialog.cntError); 
			StdLog.String('<<< Win-Api-Error '); StdLog.Int(res); StdLog.String(' >>>'); StdLog.Ln; 
			(* DosFiles.ShowApiError; *)
			IF dialog.trapOnError THEN ASSERT(res = 1) END;
		END;
	END DeleteFolder; 

	 (* Proof the names *)

	PROCEDURE BuildNewName (IN old: ARRAY OF CHAR; OUT new: ARRAY OF CHAR);
		VAR i, j: INTEGER;
	BEGIN
		IF dialog.replaceSpecialChar THEN
			j := 0;
			FOR i := 0 TO LEN(old$) DO
				new[j] := InfoTrans.TransChar1(old[i]);
				INC(j);
			END;
			new[j] := 0X;
			InfoTrans.Trim(new);
		ELSE
			new := old$;
		END;
		IF dialog.toLowercase THEN
			Strings.ToLower(new, new);
		END;
		IF LEN(new$) > n1 THEN
			FOR i := 4+keep TO 0 BY -1 DO
				new[n1-i] := new[LEN(new$)-i];
			END;
		END;
	END BuildNewName;

	PROCEDURE CheckSpecialChar (IN path, name: ARRAY OF CHAR);
	VAR
		i, n: INTEGER;
		ok : BOOLEAN;
	BEGIN
		n := LEN(name$); ok  := TRUE;
		IF dialog.replaceSpecialChar OR ~dialog.toLowercase THEN
			i := 0;
			WHILE ok & (i < n) DO
				IF (name[i] <=20X) OR (name[i] >= 7FX) THEN ok := FALSE END;
				INC(i);
			END;
		END;
		IF dialog.toLowercase THEN
			i := 0;
			WHILE ok & (i < n) DO
				IF (name[i] >='A') OR (name[i] <= 'Z') THEN ok := FALSE END;
				INC(i);
			END;
		END;
		IF ~ok THEN
			INC(dialog.cntSpecialChar);
			IF dialog.replaceSpecialChar OR dialog.toLowercase THEN
				IF dialog.testOnly THEN
					StdLog.Ln; StdLog.String('Name with special character:'); StdLog.Ln;
					StdLog.Tab; WriteLink(path$); StdLog.Ln;
					StdLog.Tab; StdLog.String(name$); StdLog.Ln;
				ELSE
					BuildNewName(dialog.oldname, dialog.newname); task := 1; (* Rename File *)
				END;
			END;
		END;
	END CheckSpecialChar;

	PROCEDURE CheckName (IN path, name: ARRAY OF CHAR);
	VAR 
		ok: BOOLEAN;
	BEGIN
		IF (LEN(name$) <= n1) THEN 
			ok := TRUE;
		ELSE
			ok := FALSE;
			INC(dialog.cntToolong);
			IF dialog.renameLongNames THEN
				IF dialog.testOnly OR (LEN(path$) + LEN(name$) + 1 >= n2) THEN
					StdLog.Ln; StdLog.String('Filename too long:'); StdLog.Ln;
					StdLog.Tab; WriteLink(path$); StdLog.Ln;
					StdLog.Tab; StdLog.String(name$); StdLog.Ln;
				ELSE
					BuildNewName(dialog.oldname, dialog.newname); task := 1; (* Rename File *)
				END;
			END;
		END;
		CheckSpecialChar(path, name);
	END CheckName;

	PROCEDURE CheckDeep (IN path, name: ARRAY OF CHAR; VAR ok: BOOLEAN);
	BEGIN
		IF (LEN(path$) + LEN(name$) + 1 < n2) THEN 
			ok := TRUE;
		ELSE
			ok := FALSE;
			INC(dialog.cntToodeep);
			IF dialog.testOnly & dialog.renameLongNames THEN
				StdLog.Ln; StdLog.String('Path too deep:'); StdLog.Ln;
				StdLog.Tab; WriteLink(path$); StdLog.Ln;
				StdLog.Tab; StdLog.String(name$); StdLog.Ln;
			END;
		END;
	END CheckDeep;

	 (* Commandos for the first form *)

	PROCEDURE Init;
	BEGIN
		dialog.path := dialog.source$; dialog.oldname := ''; dialog.newname := '';
		dialog.cntLocations := 0; dialog.cntFiles := 0; dialog.cntBytes := 0;
		dialog.cntToolong := 0; dialog.cntToodeep := 0; dialog.cntEmpty := 0;
		dialog.cntLocations := 0; dialog.cntFiles := 0; dialog.cntBytes := 0; 
		dialog.cntToolong := 0;  dialog.cntToodeep := 0;  dialog.cntEmpty := 0; dialog.cntSpecialChar:= 0; 
		dialog.cntRenamed := 0; dialog.cntDeleted := 0; dialog.cntSkip := 0; dialog.cntError := 0; 
		Dialog.Update(dialog);
	END Init;

	PROCEDURE  Start*;
	BEGIN
		TboxTimer.Start;
		Init;
		NEW(a);
		NEW(a.pos);
		a.pos.last := NIL;
		a.pos.state := 1;
		running := TRUE;
		waiting := FALSE;
		Services.DoLater(a, Services.now);
	END Start;

	PROCEDURE Stop*;
	BEGIN
		IF (a # NIL) & (a.pos = NIL) & running THEN
			dialog.oldname := ''; Dialog.Update(dialog);
			StdLog.Ln;
			StdLog.Int(dialog.cntLocations); StdLog.String(" folders"); StdLog.Ln;
			StdLog.Int(dialog.cntFiles); StdLog.String(" files"); StdLog.Ln;
			StdLog.Int(dialog.cntBytes); StdLog.String(" Bytes"); StdLog.Ln;
			StdLog.Ln;
			StdLog.Int(dialog.cntToolong); StdLog.String(" names are too long"); StdLog.Ln;
			StdLog.Int(dialog.cntToodeep); StdLog.String(" paths are too long"); StdLog.Ln;
			StdLog.Int(dialog.cntEmpty); StdLog.String(" folders/files are empty"); StdLog.Ln;
			StdLog.Int(dialog.cntSpecialChar); StdLog.String(" names with special characters"); StdLog.Ln;
			StdLog.Ln;
			IF ~dialog.testOnly THEN
				StdLog.Int(dialog.cntRenamed); StdLog.String(" files renamed"); StdLog.Ln;
				StdLog.Int(dialog.cntDeleted); StdLog.String(" directories deleted"); StdLog.Ln;
				StdLog.Int(dialog.cntSkip); StdLog.String(" operation not done"); StdLog.Ln;
				StdLog.Int(dialog.cntError); StdLog.String(" errors"); StdLog.Ln;
				StdLog.Ln;
			END;
			a := NIL;
			TboxTimer.Stop;
		END;
		running := FALSE;
	END Stop;

	PROCEDURE Continue*;	(* and Skip *)
	BEGIN
		running := TRUE;
		waiting := FALSE;
		Services.DoLater(a, Services.now)
	END Continue;

	 (* Commandos for the second form *)

	PROCEDURE Accept;
	BEGIN
		CASE task OF
		0:  (* No Task - Nothing To Do *)
		| 1:  (* Delete Or Rename Long File Names *)
			IF dialog.newname$ = '' THEN
				DeleteFile(dialog.path$, dialog.oldname$);
			ELSE
				RenameFile(dialog.path$, dialog.oldname$, dialog.newname$);
			END;
		| 2: (* Delete Empty Folders *)
			DeleteFolder(dialog.path$+dialog.oldname$);
		ELSE
			 (* Task Not Done *)
			INC(dialog.cntSkip);
		END;
	END Accept;

	PROCEDURE ShowFolder*;
	BEGIN
		InfoCmds.Start(dialog.path$)
	END ShowFolder;

	PROCEDURE CopyName*;
	BEGIN
		IF dialog.newname$ # dialog.oldname$ THEN
			dialog.newname := dialog.oldname;
		ELSE
			dialog.newname := '';
		END;
		Dialog.Update(dialog);
	END CopyName;

	PROCEDURE Rename*;
	BEGIN
		INC(a.pos.n);
		task := 1; Accept; Continue;
	END Rename;

	PROCEDURE Skip*;
	BEGIN
		task := 3; Accept; Continue;
	END Skip;

	PROCEDURE Delete*;
	BEGIN
		(* task 1 or 2 *) Accept; Continue;
	END Delete;

	(* Enable / Disable Commands *) 

	PROCEDURE StartGuard* (VAR par: Dialog.Par);
	BEGIN
		IF ~running THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END StartGuard;

	PROCEDURE StopGuard* (VAR par: Dialog.Par);
	BEGIN
		IF running THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END StopGuard;

	PROCEDURE ContinueGuard* (VAR par: Dialog.Par);
	BEGIN
		IF (a # NIL) & ~running THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END ContinueGuard;

	PROCEDURE ShowFolderGuard* (VAR par: Dialog.Par);
	BEGIN
		IF dialog.path # '' THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END ShowFolderGuard;

	PROCEDURE CopyNameGuard* (VAR par: Dialog.Par);
	BEGIN
		IF dialog.newname$ # dialog.oldname$ THEN
			par.label := "#Info:Copy Name";
		ELSE
			par.label := "#Info:Clear Name";
		END;
		IF waiting THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END CopyNameGuard;

	PROCEDURE RenameGuard* (VAR par: Dialog.Par);
	VAR
		n: INTEGER;
	BEGIN
		n := LEN(dialog.newname$);
		IF waiting & (n > 0) & (n <=  n1) THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END RenameGuard;

	PROCEDURE SkipGuard* (VAR par: Dialog.Par);
	BEGIN
		IF waiting THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END SkipGuard;

	PROCEDURE DeleteGuard* (VAR par: Dialog.Par);
	VAR
		n: INTEGER;
	BEGIN
		n := LEN(dialog.newname$);
		IF waiting & (n = 0) THEN par.disabled := FALSE ELSE par.disabled := TRUE END;
	END DeleteGuard;

	(* Check all file names *)

	PROCEDURE (a: Action) Do;
	VAR
		cnt: INTEGER;
		ok: BOOLEAN;
		p: Node;
	BEGIN
		cnt := 0;
		task := 0;
		dialog.newname := '';
		WHILE (a.pos # NIL) & (cnt < speed) & (task = 0) DO
			INC(cnt);
			CASE a.pos.state OF
			1: (* State 1: Read location & file list *)
				INC(dialog.cntLocations);
				a.pos.root := Files.dir.This(dialog.path$);
				a.pos.files := Files.dir.FileList(a.pos.root); (* DosSort.FileList(a.pos.files); *)
				a.pos.locs := Files.dir.LocList(a.pos.root); (* DosSort.LocList(a.pos.locs); *)
				a.pos.n := 0;
				a.pos.len := LEN(dialog.path$);
				a.pos.state := 2;
			| 2: (* State 2: Proof all file name *)
				IF a.pos.files # NIL THEN
					INC(a.pos.n);
					INC(dialog.cntFiles);
					dialog.oldname := a.pos.files.name$;
					dialog.cntBytes := dialog.cntBytes + a.pos.files.length;
					Dialog.Update(dialog);
					CheckName(dialog.path$, dialog.oldname$);
					CheckDeep(dialog.path$, dialog.oldname$, ok);
					a.pos.files := a.pos.files.next
				ELSE
					a.pos.state := 3;
				END;
			| 3: (* State 3: Proof location name and look at their files *)
				IF a.pos.locs # NIL THEN
					dialog.oldname := a.pos.locs.name$;
					Dialog.Update(dialog);
					CheckName(dialog.path$, dialog.oldname$);
					CheckDeep(dialog.path$, dialog.oldname$, ok); 
					IF ok & dialog.include THEN
						dialog.path := dialog.path$ + a.pos.locs.name$ + "/";
						a.pos.locs := a.pos.locs.next;
						NEW(p);
						p.last := a.pos;
						a.pos := p;
						a.pos.state := 1;
					ELSE
						a.pos.locs := a.pos.locs.next;
					END;
				ELSE
					a.pos.state := 4;
				END;		
			| 4: (* State 4: All done for this location - next location  *)
				dialog.oldname := '';
				dialog.newname := '';
				IF a.pos.n = 0 THEN 
					INC(dialog.cntEmpty); 
					Dialog.Update(dialog);
					IF dialog.deleteEmptyFolders THEN
						IF dialog.testOnly THEN
							StdLog.Ln; StdLog.String('Folder is empty:'); StdLog.Ln;
							StdLog.Tab; WriteLink(dialog.path$); StdLog.Ln;
						ELSE
							task := 2; (* Delete Folder *)
						END;
					END;
				END; 
				IF a.pos.last # NIL THEN 
					a.pos.last.n := a.pos.last.n + a.pos.n; 
					Strings.Extract(dialog.path, a.pos.last.len, a.pos.len-a.pos.last.len-1, dialog.oldname);
				END;
				a.pos := a.pos.last;
				IF a.pos # NIL THEN dialog.path[a.pos.len] := 0X END;
(*
				(* Sonderfall: Delete Profiles *)
				(* Can't read and delete files with names like .java, .hotjava, .jinit ... *)
				IF (dialog.oldname$ = 'Profiles') OR (dialog.oldname$ = 'profiles') THEN 
					DosFiles.RemoveTree(dialog.path$+dialog.oldname$+'/');
					DosFiles.RemoveDir(dialog.path$+dialog.oldname$);
					task := 0;
				END;
*)
			END;
			Dialog.Update(dialog);
		END;
		IF (task # 0) & dialog.interaktive THEN
			(* wait for user's choice *)
			waiting := TRUE;
			StdCmds.OpenToolDialog('Info/Rsrc/CheckFilenames2', 'Replace Filenames');
		ELSE
			Accept;
			IF (a.pos # NIL) & running THEN Continue ELSE Stop END
		END;
	END Do;

BEGIN
	running := FALSE;
	waiting := FALSE;
	dialog.source := 'D:/BlackBox/';
	dialog.include := TRUE; dialog.interaktive := TRUE; 
	dialog.trapOnError := FALSE; dialog.testOnly := TRUE;
	dialog.renameLongNames := FALSE; dialog.deleteEmptyFolders := FALSE; 
	dialog.replaceSpecialChar := FALSE; dialog.toLowercase := FALSE;
	Init;
END InfoCheckFilenames.
