Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

rm - remove files (an example for command line parsing)

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • rm - remove files (an example for command line parsing)

    Code:
    '  ---------------------------------------------------------------------------
    '  Source name     : RM.BAS
    '  Executable name : RM.EXE
    '  Version         : 1.0
    '  Created         : 05-Apr-2005
    '  Last update     : 18-Apr-2005
    '  Author          : Albert Richheimer
    '  Description     : Remove (unlink) files
    '  ---------------------------------------------------------------------------
    #compile exe
    #dim all
    #include "Julian.inc"
    #include "WIN32API.INC"
    
    $ProgName = "rm"
    
    declare function GetInspect(sText as string, lMode as long) as long
    declare sub GetCmdLine
    declare sub ParseOptions
    declare sub ErrDisp(sText as string)
    declare sub WalkTree(sBasePath as string)
    declare sub ClearFile(sFilePath as string)
    
    global gSwStop   as long
    global gSwError  as long
    global gSwDispl  as long
    global gOptTab() as string
    global gArgTab() as string
    global gOptPtr   as long
    global gArgPtr   as long
    
    global gExpDays  as long
    global gDirMode  as long
    global gDirRoot  as long
    global gFileName as string
    global gBasePath as string
    global gExTime   as FILETIME
    
    global gSwExp    as long
    global gSwHlp    as long
    global gSwIns    as long
    global gSwLog    as long
    global gSwRec    as long
    global gSwSec    as long
    global gSwTer    as long
    
    function pbmain as long
        local dwFile    as dword
        local lTemp     as long
        local szOrig    as asciiz*%MAX_PATH
        local szDest    as asciiz*%MAX_PATH
        local tdy       as SYSTEMTIME
        local sExpDate  as string
    
        gSwStop=cursorx+cursory=2
        SetFileApisToOEM
        GetCmdLine
        ParseOptions
    
        if gArgPtr=0 or gSwHlp then
           stdout ""
           stdout "rm - remove (unlink) files"
           stdout ""
           stdout "  usage:   rm [-eNhilrst] f1 f2 ... fn"
           stdout ""
           stdout "  options:"
           stdout "    e: N(0-9999)   - expiration days"
           stdout "    h: help banner - this page"
           stdout "    i: inspect     - ask before removing"
           stdout "    l: log mode    - report to standard output"
           stdout "    r: recurse     - traverse directory tree"
           stdout "    s: secure mode - clear file before removing"
           stdout "    t: terse mode  - suppress warnings"
           stdout ""
           stdout "  filenames f1 f2 ... fn may include path name and any"
           stdout "  wildcard specification."
           stdout ""
           stdout "Copyright (c) 1986, 2005 by Richheimer + Richheimer"
           stdout "                            IT Consultants"
           stdout "                            CH-4116 Metzerlen & Horsham/UK"
           stdout "                            <A HREF="http://consulting.richheimer.org"" TARGET=_blank>http://consulting.richheimer.org"</A> 
           gSwDispl=%TRUE
           goto closedown
        end if
    
        sExpDate=Julian2Date(Date2Julian(date$)-gExpdays)
    
        tdy.wYear         = val(mid$(sExpDate,7,4))
        tdy.wMonth        = val(mid$(sExpDate,1,2))
        tdy.wDay          = val(mid$(sExpDate,4,2))
        tdy.wHour         = val(mid$(time$,1,2))
        tdy.wMinute       = val(mid$(time$,4,2))
        tdy.wSecond       = val(mid$(time$,7,2))
        tdy.wMilliseconds = 0
        SystemTimeToFileTime tdy, gExTime
    
        for lTemp=1 to gArgPtr
            gDirRoot  = %FALSE
            szOrig=gArgTab(lTemp)
            GetFullPathName szOrig,sizeof(szDest),szDest,dwFile
    
            select case left$(szDest,2)
              case "\\"
                if tally(szDest,"\")<4 then
                   ErrDisp "Illegal UNC specification: "+szDest
                   goto b0900
                end if
                if tally(szDest,"\")<5 then
                   gDirRoot = %TRUE
                end if
              case else
                mid$(szDest,1,1)=ucase$(mid$(szDest,1,1))
                if tally(szDest,"\")<2 then
                   gDirRoot = %TRUE
                end if
            end select
    
            if (getattr(szDest) and %SUBDIR) then
               gBasePath = szDest
               gFileName = "*"
               gDirMode  = %TRUE
            else
               gBasePath = left$(szDest,dwFile-varptr(szDest))
               gFileName = mid$(szDest,dwFile-varptr(szDest)+1)
               gDirMode  = %FALSE
            end if
    
            if right$(gBasePath,1)<>"\" then
               gBasePath=gBasePath+"\"
            end if
    
            if gSwExp and gDirMode then
                ErrDisp "Cannot apply expiration days in directory mode."
                goto closedown
            end if
    
            WalkTree gBasePath
    
    b0900:
        next lTemp
    
    
    closedown:
        if gSwDispl or gSwError then
           if gSwStop then
              stderr ""
              stderr "press any key to continue...";
              waitkey$
           end if
        end if
    
        function=gSwError
    
    end function
    
    
    '
    '   Get Command Line Args
    '   ---------------------
    '
    '   returns global gOptTab() as string
    '                  gArgTab() as string
    '
    sub GetCmdLine
        local lTemp   as long
        local sLine   as string
        local sTemp   as string
    
        sLine=rtrim$(command$)
        gOptPtr=0
        redim gOptTab(10) as global string
        gArgPtr=0
        redim gArgTab(10) as global string
    
    getcom0110:
        sLine=trim$(sLine)
        if left$(sLine,1)<>"-" then goto getcom0200
        sLine=mid$(sLine,2)
        do
          if left$(sLine,1)=$spc then exit loop
          incr gOptPtr
          if gOptPtr>ubound(gOptTab) then
             redim preserve gOptTab(ubound(gOptTab)+10) as global string
          end if
          lTemp=instr(sLine,$spc)
          if lTemp then
             gOptTab(gOptPtr)=ucase$(left$(sLine,lTemp-1))
             sLine=mid$(sLine,lTemp)
          else
             gOptTab(gOptPtr)=ucase$(sLine)
             sLine=""
          end if
        loop while len(sLine)
        if len(sLine) then goto getcom0110
    
    getcom0200:
        while len(sLine)
           if left$(sLine,1)=$DQ or left$(sLine,1)="'" then
              lTemp=instr(2,sLine,left$(sLine,1))
              if lTemp=0 then
                 sTemp=extract$(sLine,any $SPC+$TAB)
                 sLine=remain$(sLine,any $SPC+$TAB)
                 goto getcom0210
              else
                 sTemp=extract$(2,sLine,left$(sLine,1))
                 sLine=remain$(2,sLine,left$(sLine,1))
                 goto getcom0210
              end if
           else
              sTemp=extract$(sLine,any $SPC+$TAB)
              sLine=remain$(sLine,any $SPC+$TAB)
           end if
    
    getcom0210:
           incr gArgPtr
           if gArgPtr>ubound(gArgTab) then
              redim preserve gArgTab(ubound(gArgTab)+10) as global string
           end if
           gArgTab(gArgPtr)=sTemp
           sLine=ltrim$(sLine)
        wend
    
    getcom0300:
        redim preserve gOptTab(gOptPtr) as global string
        redim preserve gArgTab(gArgPtr) as global string
    end sub
    
    
    sub ErrDisp(sText as string)
        stderr $ProgName+": "+sText
        gSwError=%TRUE
        gSwDispl=%TRUE
        beep
    end sub
    
    
    sub ParseOptions
        local lTemp    as long
        local sTemp    as string
        for lTemp=1 to gOptPtr
            sTemp=gOptTab(lTemp)
            do
              select case left$(sTemp,1)
                case "E"
                  gSwExp=%TRUE
                    while mid$(sTemp,2,1)<="9" and mid$(sTemp,2,1)>="0"
                      gExpDays=gExpDays*10+val(mid$(sTemp,2,1))
                      sTemp=mid$(sTemp,2)
                    wend
                case "H"
                  gSwHlp=%TRUE
                case "I"
                  gSwIns=%TRUE
                case "L"
                  gSwLog=%TRUE
                case "R"
                  gSwRec=%TRUE
                case "S"
                  gSwSec=%TRUE
                case "T"
                  gSwTer=%TRUE
                case else
                  ErrDisp "Illegal option: "+left$(sTemp,1)
              end select
              sTemp=mid$(sTemp,2)
            loop while len(sTemp)
        next lTemp
    end sub
    
    function GetInspect(sText as string, lMode as long) as long
        local sLine as string
        local sByte as string
        if lMode then
           sLine="Remove directory "+sText+" (y/n)? "
        else
           sLine="Remove file "+sText+" (y/n)? "
        end if
        stdout $ProgName+": "+sLine;
        while %TRUE
          do
            sleep 1
            sByte=inkey$
          loop while sByte=""
          if sByte="y" or sByte="Y" then
             stdout "Y"
             function=%TRUE
             exit loop
          end if
          if sByte="n" or sByte="N" then
             stdout "N"
             function=%FALSE
             exit loop
          end if
        wend
    end function
    
    sub WalkTree(sBasePath as string)
        local sLine   as string
        local szPath  as asciiz*%MAX_PATH
        local WFD     as WIN32_FIND_DATA
        local hSearch as dword
        szPath=sBasePath+gFileName
        hSearch=FindFirstFile(szPath,WFD)
        if hSearch<>%INVALID_HANDLE_VALUE then
           do
             if (WFD.dwFileAttributes and %FILE_ATTRIBUTE_DIRECTORY)= _
                %FILE_ATTRIBUTE_DIRECTORY then goto walktre0100
             if gSwExp then
                if CompareFileTime(WFD.ftLastWriteTime,gExTime)>0 then
                   goto walktre0100
                end if
             end if
             if gSwIns=%FALSE or GetInspect(sBasePath$+WFD.cFileName,0) then
                setattr sBasePath$+WFD.cFileName,0
                if gSwSec then
                   ClearFile sBasePath$+WFD.cFileName
                end if
                errclear
                kill sBasePath$+WFD.cFileName
                if err then
                   if gSwTer=0 then
                      ErrDisp error$(err)+": "+sBasePath$+WFD.cFileName
                   end if
                else
                   if gSwLog then
                      stdout "removed file: "+sBasePath$+WFD.cFileName
                      gSwDispl=%TRUE
                   end if
                end if
             end if
    
    walktre0100:
           loop while FindNextFile(hSearch,WFD)
           FindClose(hSearch)
        else
           if gDirMode=%FALSE then
              if gSwTer=%FALSE then
                 ErrDisp "Cannot find "+szPath
              end if
           end if
        end if
    
    walktre0110:
        szPath=sBasePath+"*"
        hSearch=FindFirstFile(szPath,WFD)
        if hSearch<>%INVALID_HANDLE_VALUE then
           do
             if (WFD.dwFileAttributes and %FILE_ATTRIBUTE_DIRECTORY)<> _
                %FILE_ATTRIBUTE_DIRECTORY then goto walktre0200
             if WFD.cFileName="." or WFD.cFileName=".." then goto walktre0200
             if gSwRec then
                WalkTree sBasePath+rtrim$(WFD.cFileName,$nul)+"\"
             end if
    
    walktre0200:
           loop while FindNextFile(hSearch,WFD)
           FindClose(hSearch)
        end if
        if gDirMode and gSwRec then
           if gDirRoot=%TRUE and sBasePath=gBasePath then exit if
           if gSwIns=%FALSE or GetInspect(sBasePath$,1) then
              errclear
              rmdir sBasePath
              if err then
                 if gSwTer=0 then
                    ErrDisp error$(err)+": "+sBasePath$
                 end if
              else
                 if gSwLog then
                    stdout "removed directory: "+sBasePath$
                    gSwDispl=%TRUE
                 end if
              end if
           end if
        end if
    end sub
    
    sub ClearFile(sFilePath as string)
        local hFile as long
        local qSize as quad
        local qRecs as quad
        local qTemp as quad
        local lBuff as long
        local lRemd as long
        lBuff=1000*1024
        hFile=freefile
        open sFilePath for binary as #hFile
        qSize=lof(hFile)
        qRecs=qSize\lBuff
        lRemd=qSize mod lBuff
        for qTemp=1 to qRecs
            put$ #hFile,string$(lBuff,0)
        next qTemp
        if lRemd then
           put$ #hFile,string$(lRemd,0)
        end if
        close #hFile
    end sub
    
    ' JULIAN.INC
    ' ----------
    '
    '   Date MM-DD-YYYY --> Long
    '   ------------------------
    '
    function Date2Julian(MM_DD_YYYY as string) as long
        local lMonth as long
        local lDay   as long
        local lYear  as long
        local k      as long
        local Julian as long
        lMonth = val(left$(MM_DD_YYYY$,2))
        lDay   = val(mid$(MM_DD_YYYY$,4,2))
        lYear  = val (right$(MM_DD_YYYY$,4))
        k = int((14 - lMonth) / 12)
        Julian=lDay+int(367*(lMonth+(k*12)-2)/12) _
                      + int(1461*(lYear+4800-k)/4)-32113
        Julian=Julian -(int(3*int((lYear+100-k)/100)/4)-2)
        Date2Julian = Julian
    end function
    
    
    '
    '   Long --> Date MM-DD-YYYY
    '   ------------------------
    '
    function Julian2Date(JD as long) as string
      local sYr as string
      local sMo as string
      local sDa as string
      local lM  as long
      local lD  as long
      local lY  as long
      local lQ  as long
      local lR  as long
      local lS  as long
      local lT  as long
      local lU  as long
      local lV  as long
      lQ=int((JD / 36524.25) - 51.12264)
      lR=JD+lQ-int(lQ/4)+1
      lS=lR+1524
      lT=int((lS/365.25)-0.3343)
      lU=int(lT*365.25)
      lV=int((lS-lU)/30.61)
      lD=lS-lU-int(lV*30.61)
      lM=(lV-1)+12*(lV>13.5)
      lY=lT-(lM<2.5)-4716
      sYr=right$(str$(lY),len(str$(lY))-1)
      if len(sYr)<2 then sYr="0"+sYr
      sMo=right$(str$(lM),len(str$(lM))-1)
      if len(sMo)<2 then sMo="0"+sMo
      sDa=right$(str$(lD),len(str$(lD))-1)
      if len(sDa)<2 then sDa="0"+sDa
      Julian2Date=sMo+"-"+sDa+"-"+sYr
    end function
    ------------------
    Albert Richheimer
    http://consulting.richheimer.org
    http://www.chlohn.ch


    [This message has been edited by Albert Richheimer (edited November 09, 2006).]
    „Let the machine do the dirty work.“
    The Elements of Programming Style, Brian W. Kernighan, P. J. Plauger 1978
Working...
X