rd

Descripción del contenido de la página

Utilidad para renombrar ficheros en la Psion 5mx.

Etiquetas:

Escribí esta utilidad para renombrar ficheros y directorios de mi Psion 5mx, en OPL. Al igual que con Renombrador (otro programa similar más sencillo) que escribí, hay que modificar en el código la llamada al procedimiento que ha de hacer el cálculo del nuevo nombre, pero este programa permite elegir varias opciones con su propia interfaz de preguntas.

Código fuente

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

Descargas