rd

Priskribo de la ĉi-paĝa enhavo

Nomigilo dosierojn kaj dosierujojn de Psion 5mx.

Etikedoj:

Mi verkis ĉi programon en OPL por renomigi dosierojn kaj dosierujojn de mia Psion 5mx. La fontkodon endas modifi por voki la proceduron kiu efektive alinomigu la dosierojn (same pri Renombrador, pli simpla renomigilo kiun mi verkis). La programo ebligas la uzanton elekti el diversaj ebloj, per demandoj.

Fontkodo

rem =================================
rem rd

rem Herramienta para renombrar archivos y directorios de la Psion 5mx.
rem Nomigilo dosierojn kaj dosierujojn de Psion 5mx.
rem Tool to rename Psion 5mx's files and directories.

rem Copyright (C) 2005-2008 Marcos Cruz (http://programandala.net)
rem Licencia/Permesilo/License:
rem http://programandala.net/license

rem =================================
rem History

rem 2005-10-22
rem First version.

rem 2006-02-04
rem New: Confirmation.

rem 2007-01-20
rem Trivial update: New proc to change spaces into underscores.

rem 2008-01-23
rem New procs to rename Psion fles.
rem New option "a" while confirming each file.
rem Default path.

rem 2008-10-27
rem New proc to translate Spanish letter to English letters.
rem New option to print on screen all files as they are found.
rem New option to beep when asking for confirmation.

rem =================================
rem Requirements

rem This program uses the AldurFile OPX © 2003-4 by Graham L. Holden:
rem http://www.g-holden.dircon.co.uk
rem g-holden (arroba/heliko/at) dircon (punto/punkto/dot) co (punto/punkto/dot) uk

include "AldurFile.oxh"

rem =================================
rem Main

proc main:

	global count& rem renamed files
	global confirm% rem confirm every file to be renamed?
	global print_all% rem print all file names on screen as they are found?
	global beep% rem beep when asking for confirmation?
	global files&
	
	local path$(255)
	local default_path$(255)

	default_path$ = "c:\doc\*"
	
	cls
	print "rd"
	print

	print "Path and filter? (default: "+default_path$+")",
	input path$
	if path$=""
		path$=default_path$
	endif
	rem path$="d:\dat_doc\doc"
	rem path$="c:\doc"

	print "Print all file names as they are found? [Y/N]",
	print_all% = lower$(get$)="y"
	print

	print "Confirm before rename? [Y/N]",
	confirm% = lower$(get$)="y"
	print

	if confirm%
		print "Beep when asking for confirmation? [Y/N]",
		beep% = lower$(get$)="y"
		print
	endif

	scan_directory:( path$,0 )
	print
	files& = count&
	count& = 0
	scan_directory:( path$,1 )

	final_report:

endp

rem =================================
rem Final report

proc final_report:

	print
	print files&,"file";left$("s",iabs(files&>0));" renamed."
	print count&,"director";left$("y",iabs(count&=1));left$("ies",3*abs(count&>1 or count&=0));" renamed."

	print "Press any key to exit."
	Get

endp

rem =================================
rem Scan directory

proc scan_directory:( base_dir$, directories_only% )

	local new_name$(255)

	DirOpen&:( base_dir$, KAttrAll&, KSortByName% )

	while DirNext%:

		if DirIsDirectory%:	

			scan_directory:( DirFullName$: + "\",directories_only% )

			if directories_only%
				manage$:(Dirname$:)
			endif

		elseif directories_only%=0

			manage$:(DirName$:)

		endif

		if key=%e
			stop
		endif

	endwh

	DirClose&:

endp

rem =================================
rem Manage the file

proc manage$:(original_name$)

	rem Manage the file to be renamed

	local new_name$(255)
	local rename% rem has the file to be renamed?
	local confirmed% rem rename confirmed
	local confirm_key$(1)
	
	if print_all%
		print original_name$
	endif

	rem Example to take out spaces or underscores from the file names:

rem	new_name$ = no_underscores$:(original_name$)
rem	new_name$ = no_spaces$:(original_name$)
rem	rename% = new_name$ <> original_name$

	rem Example to rename .txt (text) files to .f (Forth)

rem	rename% = lower$(right$(original_name$,4))=".txt"
rem	if rename%
rem		new_name$ = lower$(left$(original_name$,len(original_name$)-4))+".f"
rem	endif

	rem Example to rename .psiword (psion word) to .psw

rem	rename% = lower$(right$(original_name$,8))=".psiword"
rem	if rename%
rem		new_name$ = lower$(left$(original_name$,len(original_name$)-8))+".psw"
rem	endif

	rem Examples to rename all files by a proc

rem	rename% = 1 
rem print original_name$
rem pause 0
rem new_name$ = img$:(original_name$)

rem	new_name$ = psion_longer$:(original_name$)
	new_name$ = no_spanish_letters$:(original_name$)

	rename% = new_name$ <> original_name$

	if rename%
		print DirPath$:+original_name$;" -> "
		print DirPath$:+new_name$;
		if confirm%
			do
				print
				print " Rename? [y/n/a/q]"
				if beep%
					beep 4,800
					beep 8,300
				endif
				confirm_key$=lower$(get$)
			until loc("ynaq",confirm_key$)
			if confirm_key$="q"
				final_report:
				stop
			endif
			confirm% = (confirm_key$<>"a")
			confirmed% = (confirm_key$="y") or not confirm%
		else
			print
			confirmed% = 1
		endif
		if confirmed%
			rename DirPath$:+original_name$,DirPath$:+new_name$
			count& = count&+1
		endif
	endif

endp


rem =================================
rem Procs to do renamings

proc no_spaces$:(file_name$)

	local new_name$(255)
	local addr& rem address of new_name$
	local i% rem counter

	rem new_name$ = lower$(file_name$)
	new_name$ = file_name$

	addr& = addr(new_name$)
	i% = len(new_name$)

	while i%
		if peekb(addr&+i%) = 32 rem space...
			pokeb addr&+i%,%_ rem ... changed to underscore
		endif
		i% = i%-1
	endwh

	return new_name$

endp

proc no_underscores$:(file_name$)

	local new_name$(255)
	local addr& rem address of new_name$
	local i% rem counter

	rem new_name$ = lower$(file_name$)
	new_name$ = file_name$

	addr& = addr(new_name$)
	i% = len(new_name$)

	while i%
		if peekb(addr&+i%) = %_ rem udnerscore...
			pokeb addr&+i%,32 rem ... changed to space
		endif
		i% = i%-1
	endwh

	return new_name$

endp

proc img$:(file_name$)

	rem 2006 06 02
	
	rem Rename file names from the format:
	rem 	"yyyy-mm-dd_hh-mm-ss_name-1.jpg"
	rem to:
	rem 	"yyyymmddhhmm_name.jpg"

	local new_name$(255)
	local c$(1) rem char
	local i%
	
	rem Take out all "-"
	
	i% = len(file_name$)
	while i%
		c$ = mid$(file_name$,i%,1)
		if c$<>"-"
			new_name$=c$+new_name$
		endif
		i% = i%-1
	endwh

	rem Take out the "1."

	i% = loc(new_name$,"1.")
	new_name$ = left$(new_name$,i%-1)+right$(new_name$,len(new_name$)-i%)

	rem Take out the first "_"

	i% = loc(new_name$,"_")
	new_name$ = left$(new_name$,i%-1)+right$(new_name$,len(new_name$)-i%)
	
	return new_name$
	
endp

proc psion_shorter$:(file_name$)

	rem Rename Psion files with shorter extensions.
	
	rem 2008-01-23
	
	local new_name$(255)
	
	new_name$ = file_name$
	
	if lower$(right$(file_name$,8))=".psiword"
		new_name$ = lower$(left$(file_name$,len(file_name$)-8))+".psw"
	else
		if lower$(right$(file_name$,9))=".psisheet"
			new_name$ = lower$(left$(file_name$,len(file_name$)-9))+".pss"
		else
				if lower$(right$(file_name$,9))=".psinotes"
					new_name$ = lower$(left$(file_name$,len(file_name$)-9))+".psn"
				endif
		endif
	endif

	return new_name$

endp

proc psion_longer$:(file_name$)

	rem Rename Psion files with longer extensions.
	
	rem 2008-01-23
	
	local new_name$(255)
	
	new_name$ = file_name$
	
	if lower$(right$(file_name$,4))=".psw"
		new_name$ = lower$(left$(file_name$,len(file_name$)-4))+".psiword"
	else
		if lower$(right$(file_name$,4))=".pss"
			new_name$ = lower$(left$(file_name$,len(file_name$)-4))+".psisheet"
		else
				if lower$(right$(file_name$,4))=".psn"
					new_name$ = lower$(left$(file_name$,len(file_name$)-4))+".psinotes"
				endif
		endif
	endif

	return new_name$

endp

proc translate_chars$:(file_name$,from_chars$,to_chars$)

	local new_name$(255),new_name&
	local i%,j% rem counters
	local old_chars$(255)
	local new_chars$(255)
	local old_chars&
	local new_chars&
	local char%

	old_chars& = addr(old_chars$)
	new_chars& = addr(new_chars$)

	new_name$ = file_name$
	new_name& = addr(new_name$)
	i% = len(new_name$)

	while i%
		char% = peekb(new_name&+i%)
		j% = len(old_chars$)
		while j%
			if peekb(old_chars&+j%)=char%
				pokeb new_name&+i%,peekb(new_chars&+j%)
			endif
			j% = j%-1
		endwh
		i% = i%-1
	endwh
	
	return new_name$

endp

proc no_spanish_letters$:(file_name$)

	return translate_chars$:(file_name$,"áóéúíÁÓÉÚÍñÑüÜ","aoeuiAOEUInNuU")

endp

Deŝutoj