home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / basic / blitzandpieces / sufferer.asc < prev    next >
Encoding:
Text File  |  1999-05-14  |  3.0 KB  |  132 lines
  1. v$="$VER: Sufferer 1.2 (16.1.99) James L Boyd"
  2.  
  3. ; add/change multiple file suffixes...
  4.  
  5. ; Author : James L Boyd - jamesboyd@all-hail.freeserve.co.uk
  6.  
  7. Function.w CentreWindowX {width.w}
  8.   x.w=(ScreenWidth/2)-(width/2)
  9. Function Return x
  10. End Function
  11.  
  12. Function.w CentreWindowY {height.w}
  13.   y.w=(ScreenHeight/2)-(height/2)
  14. Function Return y
  15. End Function
  16.  
  17. Function.w TitleBarHeight{scr.b}
  18.  
  19. If Peek.l(Addr Screen(scr))
  20.   *scr.Screen=Peek.l(Addr Screen(scr)) ; get screen info...
  21.   Function Return *scr\BarHeight+1
  22. Else Function Return False
  23. EndIf
  24.  
  25. End Function
  26.  
  27. NoCli
  28. WBStartup ; run from an icon
  29. FindScreen 0 ; find front screen and use it (for requesters)
  30.  
  31. ; this function returns the file part of "path:drawer/file" :
  32. Function$ StripFile{a$}
  33.   *fileptr.l = FilePart_(&a$)
  34.   a$=Peek$(*fileptr)
  35. Function Return a$
  36. End Function
  37.  
  38. ; this looks backwards through the filename for a dot...
  39.  
  40. Function$ StripToDot{a$}
  41.   For a.w=Len(a$) To 1 Step -1
  42.     If Mid$(a$,a,1)="." Then a$=Left$(a$,a-1):Pop For:Goto senditback
  43.     ; if it found a dot,puts result into b$,goes to senditback label below
  44.   Next a
  45. senditback
  46.   Function Return a$
  47. End Function
  48.  
  49. #maxfiles=5000
  50.  
  51. Dim fil$(#maxfiles) ; max no of files
  52. path$="RAM:"   ; default drawer
  53. pat$="#?"      ; file pattern
  54.  
  55. .select_files
  56.  
  57. counter.w=0 ; keep track of files!
  58.  
  59.   RTEZSetDefaultDirectory 2,path$
  60.   RTEZSetDefaultDirectory 3,path$
  61.   RTEZSetPattern 3,pat$
  62.  
  63.   ret.b=RTEZMultiLoadFile("Select file(s) to Suffer!")
  64.  
  65.   If ret ; files chosen
  66.  
  67.       fil$(counter)=RTNextPathEntry ; can't remember why you have to
  68.                                     ; do a dummy one...
  69.  
  70. ; now read 'em :
  71.  
  72.       While fil$(counter)<>"" AND ret
  73.         counter+1
  74.           If counter>#maxfiles
  75.             rt.b=RTEZRequest("Sufferer","Oops - maximum of #maxfiles files!","Doh!")
  76.             Pop If:Pop While:Goto select_files
  77.           EndIf
  78.         fil$(counter)=RTNextPathEntry
  79.       Wend
  80.  
  81. info$="Enter new suffix or type STRIP to strip suffixes"
  82.  
  83. suffer$=RTEZGetString("Sufferer",info$,10)
  84.  
  85. ; WARNING ! This command is bugged,and causes an Enforcer
  86. ;           hit if Cancel if clicked on,or an empty string
  87. ;           given (hence the Abort default string) !
  88.  
  89. If suffer$="" Then End
  90. If UCase$(suffer$)="STRIP" Then suffer$=""
  91.  
  92. If Len(suffer$)>0 Then If Left$(suffer$,1)<>"." Then suffer$="."+suffer$
  93.  
  94. error.b=0:error$="Error renaming the following files :||"
  95.  
  96. ; Now SUFFER,YOU BASTARDS!!!! RRRRRGGHHHHHH!!!!!!
  97.  
  98. Window 0,CentreWindowX{ScreenWidth/4},CentreWindowY{TitleBarHeight{0}},ScreenWidth/4,TitleBarHeight{0},0,"Sufferer",1,2
  99.  
  100. suc.l=PICreateRequest("Suffering...",0,counter-1)
  101.  
  102. For a.w=0 To counter-1
  103.  
  104. icon.b=0
  105.  
  106. ; make it suffer - ahem,add the suffix :
  107.  
  108.   If Right$(fil$(a),5)=".info"
  109.     b$=StripToDot{Left$(fil$(a),Len(fil$(a))-5)}
  110.     b$+suffer$+".info"
  111.  
  112.   Else
  113.     b$=StripToDot{fil$(a)}+suffer$
  114.   EndIf
  115.  
  116.   If Rename_ (&fil$(a),&b$)=0 Then error$+fil$(a)+"|":error=1
  117.  
  118. If suc Then WaitTOF_:dummy.l=PIUpdateRequest (a)
  119.  
  120. Next a
  121.  
  122. If suc Then PIEndRequest
  123.  
  124. If error Then rt.b=RTEZRequest("Sufferer",error$,"Check protect tags...")
  125.  
  126.   EndIf ; from "If ret" ...
  127.  
  128. Free Window 0
  129.  
  130. quit
  131. End
  132.