home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / AXDOS10.ZIP / PCBDOS.PPS < prev    next >
Encoding:
Text File  |  1996-09-06  |  8.7 KB  |  463 lines

  1. *USEFUNCS
  2.  
  3. Declare Procedure Input(VAR STRING Answer,INTEGER MaxLen)
  4. Declare Function NumToString(Integer thisint) string
  5. Declare Function CurDir() string
  6.  
  7. begin
  8. Boolean PauseYN
  9. Integer i
  10. Int FileBits,MaxAd
  11. String Temp,TempTwo,DirString,Ans,OrigDir,Origans,Command(10),Version(1)
  12. String FileList,Dash,Colon,Comma,EndDir,BitNotSet,ExitText
  13. String DeleteText,DeleteSure,NoParams,NoMatch,DirList,BadCommand,FlagText,RemoteOnly,BeginDL,BeginUL,ShellText
  14.  
  15. OrigDir = CWD()
  16. Version(0) = " @X08· @X09PCBoard DOS Version 1.00 @X08· @X07Coded by @X0FM@X07av@X08erick [@X0CANTi@X08-@X0FX@X08]"
  17. Version(1) = " @X08· @X07Based on iNiQUiTY's MicroDOS(C) by Mike Fricker"
  18.  
  19. ;Read from config file:
  20. Fopen 1,PpePath()+"PCBDOS.CFG",O_RD,S_DN
  21. Fget 1,ExitText
  22. Fget 1,DirString
  23. Fget 1,BadCommand
  24. Fget 1,NoParams
  25. Fget 1,NoMatch
  26. Fget 1,DeleteText
  27. Fget 1,DeleteSure
  28. Fget 1,FlagText
  29. Fget 1,RemoteOnly
  30. Fget 1,BeginDL
  31. Fget 1,BeginUL
  32. Fget 1,ShellText
  33. Fget 1,DirList
  34. Fget 1,FileList
  35. Fget 1,Dash
  36. Fget 1,Colon
  37. Fget 1,Comma
  38. Fget 1,BitNotSet
  39. Fget 1,EndDir
  40. Fclose 1
  41.  
  42. RdUNet PcbNode()
  43. WrUNet PcbNode(), "B", UN_Name(), UN_City(), UN_Name(), ""
  44.  
  45. Cls
  46. PrintLn ExitText
  47. NewLines 2
  48. PrintLn Version(0)
  49. PrintLn Version(1)
  50. NewLine
  51. MaxAd = 0
  52.  
  53. :main
  54. StartDisp FNS
  55. PauseYN = false
  56.  
  57. Newline
  58. Optext CWD()
  59. Print DirString
  60. input(ans,80-Len(CWD()))
  61. If (ans = "") Goto main
  62.  
  63. origans = ans
  64. ans = Upper(ans)
  65.  
  66. If (instr(ans,"/P") > 0) then
  67.  ans = StripStr(ans,"/P")
  68.  PauseYN = true
  69. endif
  70.  
  71. Tokenize ans
  72. ans = GetToken()
  73.  
  74. If (ans = "EXIT") then
  75.  ChDir OrigDir
  76.  End
  77. Endif
  78.  
  79. If (ans = "?" || ans = "HELP") then
  80.  If (PauseYN) StartDisp FCL
  81.  DispFile PpePath()+"PCBDOS.HLP",0
  82.  Goto next
  83. Endif
  84.  
  85. If (ans = "DIR") then
  86.  If (PauseYN) StartDisp FCL
  87.  NewLines 2
  88.  ans = GetToken()
  89.  if (ans = "") ans = "*.*"
  90.  temp = CurDir()
  91.  optext temp
  92.  PrintLn DirList
  93.  NewLine
  94.  temp = FindFirst(ans)
  95.  If (Temp = "") then
  96.   Optext ans
  97.   PrintLn NoMatch
  98.   Goto Next
  99.  Endif
  100.  i = 0
  101.  while (temp != "") do
  102.  
  103.   ans = replacestr(FileList,"@FILENAME@",Trim(FileInf(temp,8)," "))
  104.   ans = replacestr(ans,"@EXT@",Left(FileInf(temp,9),3))
  105.   ans = replacestr(ans,"@SIZE@",Space(10 - Len(StripAtx(NumToString(FileInf(temp,4)))))+NumToString(FileInf(temp,4)))
  106.   ans = replacestr(ans,"@DATE@",ReplaceStr(String(FileInf(temp,2)),"-",Dash))
  107.   ans = replacestr(ans,"@TIME@",ReplaceStr(Left(String(FileInf(temp,3)),5),":",Colon))
  108.   FileBits = FileInf(temp,5)
  109.  
  110.   if (IsBitSet(FileBits,0)) then
  111.    ans = replacestr(ans,"@R@","R")
  112.   else
  113.    ans = replacestr(ans,"@R@",BitNotSet)
  114.   endif
  115.  
  116.   if (IsBitSet(FileBits,1)) then
  117.    ans = replacestr(ans,"@H@","H")
  118.   else
  119.    ans = replacestr(ans,"@H@",BitNotSet)
  120.   endif
  121.  
  122.   if (IsBitSet(FileBits,2)) then
  123.    ans = replacestr(ans,"@S@","S")
  124.   else
  125.    ans = replacestr(ans,"@S@",BitNotSet)
  126.   endif
  127.  
  128.   if (IsBitSet(FileBits,5)) then
  129.    ans = replacestr(ans,"@A@","A")
  130.   else
  131.    ans = replacestr(ans,"@A@",BitNotSet)
  132.   endif
  133.  
  134.   if (Abort()) goto next
  135.   PrintLn Ans
  136.   inc i
  137.  
  138.   temp = findnext()
  139.  endwhile
  140.  optext NumToString(i)
  141.  PrintLn EndDir
  142.  Goto next
  143. endif
  144.  
  145. If (ans = "TYPE") then
  146.  Newlines 2
  147.  If (PauseYN) StartDisp FCL
  148.  DispFile GetToken(),0
  149.  Wait
  150.  Goto next
  151. Endif
  152.  
  153. If (ans = "CLS") then
  154.  Cls
  155.  Goto next
  156. Endif
  157.  
  158. If (left(ans,2) = "CD") then
  159.  ans = Trim(Right(Origans,(Len(Origans)-2))," ")
  160.  ChDir ans
  161.  Goto next
  162. Endif
  163.  
  164. If (ans = "MD" || ans = "MKDIR") then
  165.  MkDir GetToken()
  166.  Goto next
  167. Endif
  168.  
  169. If (ans = "RD" || ans = "RMDIR") then
  170.  ReDir GetToKen() ;Gee.. PCB's doc's fucked up on this, it's "REdir", not RMDIR
  171.  Goto next          ;least the doc's I have for PPLC 3.10 :)
  172. Endif
  173.  
  174. ;this is where it should change drives! Doesn't work though! ;(
  175. ;if ((right(ans,1) = ":") && (len(ans) = 2)) then
  176. ; ChDir ans
  177. ; goto next
  178. ;endif
  179.  
  180. If (ans = "DEL") then
  181.  ans = GetToken()
  182.  temp = FindFirst(ans)
  183.  If (Temp = "") then
  184.   Optext temp
  185.   PrintLn NoMatch
  186.   Goto Next
  187.  Endif
  188.  If (ans = "*.*") then
  189.   Newline
  190.   ans = "N"
  191.   temp = CurDir()+"*.*"
  192.   Optext temp
  193.   InputYN DeleteSure,ans,7
  194.   If (ans = YesChar()) then
  195.    Delete Temp
  196.   Endif
  197.   Goto next
  198.  Endif
  199.  while (temp != "") do
  200.   ans = "N"
  201.   If (PauseYN) then
  202.    Newline
  203.    optext Trim(temp, " ")
  204.    InputYN DeleteText,ans,7
  205.    If (ans = YesChar()) then
  206.     Delete Temp
  207.    Endif
  208.   else
  209.    delete temp
  210.   endif
  211.   temp = findnext()
  212.  endwhile
  213.  Goto next
  214. Endif
  215.  
  216. If (ans = "REN") then
  217.  temp = GetToken()
  218.  ans = GetToken()
  219.  If (temp = "" || ans = "") then
  220.   NewLines 2
  221.   PrintLn NoParams
  222.  else
  223.   Rename Temp,Ans
  224.  endif
  225.  Goto next
  226. Endif
  227.  
  228. If (ans = "EXT") then
  229.  ans = GetToKen()
  230.  if (ans = "") then
  231.   NewLines 2
  232.   PrintLn NoParams
  233.  else
  234.   temp = Trim(Right(Origans,(Len(Origans)-3))," ")
  235.   ToKenize temp
  236.   ans = GetToken()
  237.   Newline
  238.   Optext ans
  239.   PrintLn ShellText
  240.   SaveScrn
  241.   Shell true,i,ans,GetToken()
  242.   RestScrn
  243.   If (Exist("PCBDOS.TXT")) then
  244.    StartDisp FCL
  245.    NewLines 2
  246.    DispFile "PCBDOS.TXT",0
  247.    Delete "PCBDOS.TXT"
  248.    Wait
  249.   Endif
  250.  Endif
  251.  Goto next
  252. Endif
  253.  
  254. If (ans = "PPE") then
  255.  ans = GetToKen()
  256.  NewLines 2
  257.  if (ans = "") then
  258.   PrintLn NoParams
  259.  else
  260.   temp = Trim(Right(Origans,(Len(Origans)-3))," ")
  261.   Call temp
  262.  endif
  263.  Goto next
  264. endif
  265.  
  266. If (ans = "FLAG") then
  267.  TempTwo = CWD()
  268.  NewLines 2
  269.  ans = GetToKen()
  270.  if (ans = "") then
  271.   PrintLn NoParams
  272.  else
  273.   temp = findfirst(ans)
  274.   If (Temp = "") then
  275.    Optext ans
  276.    PrintLn NoMatch
  277.    Goto Next
  278.   Endif
  279.   while (temp != "") do
  280.    temp = trim(CurDir()+temp," ")
  281.    Optext temp
  282.    PrintLn FlagText
  283.    ChDir OrigDir
  284.    Flag temp
  285.    ChDir TempTwo
  286.    temp = findnext()
  287.   endwhile
  288.  endif
  289.  ChDir TempTwo
  290.  Goto next
  291. endif
  292.  
  293. If (ans = "SEND") then
  294.  If (OnLocal()) then
  295.   NewLines 2
  296.   PrintLn RemoteOnly
  297.   Goto Next
  298.  Endif
  299.  temp = CurDir()
  300.  NewLines 2
  301.  ans = GetToKen()
  302.  if (ans = "") then
  303.   PrintLn NoParams
  304.  else
  305.   temp = findfirst(temp+ans)
  306.   Fopen 1,OrigDir+"\PCBDSZ.LST",O_WR,S_DB
  307.   while (temp != "") do
  308.    Fputln 1, CurDir() + temp
  309.    temp = trim(findnext()," ")
  310.   endwhile
  311.   Fclose 1
  312.   PrintLn BeginDL
  313.   Shell true,i,"ZMSEND.EXE","@"+OrigDir+"\PCBDSZ.LST"
  314.   Delete OrigDir+"\PCBDSZ.LST"
  315.   temp = getenv("DSZLOG")
  316.   if (exist(temp)) delete temp
  317.   Newline
  318.  endif
  319.  Goto next
  320. endif
  321.  
  322. If (ans = "RECEIVE") then
  323.  If (OnLocal()) then
  324.   NewLines 2
  325.   PrintLn RemoteOnly
  326.   Goto Next
  327.  Endif
  328.  temp = CurDir()
  329.  NewLines 2
  330.  PrintLn BeginUL
  331.  Shell true,i,"ZMRECV.EXE",temp
  332.  temp = getenv("DSZLOG")
  333.  if (exist(temp)) delete temp
  334.  Newline
  335.  Goto next
  336. Endif
  337.  
  338. If (ans = "VER") then
  339.  NewLines 2
  340.  PrintLn Version(0)
  341.  PrintLn Version(1)
  342.  Goto Next
  343. Endif
  344.  
  345. :error
  346. NewLine
  347. Print BadCommand
  348.  
  349. :next
  350. If (MaxAd < 10) MaxAd = MaxAd + 1
  351.  
  352. Command(10) = Command(9)
  353. Command(9) = Command(8)
  354. Command(8) = Command(7)
  355. Command(7) = Command(6)
  356. Command(6) = Command(5)
  357. Command(5) = Command(4)
  358. Command(4) = Command(3)
  359. Command(3) = Command(2)
  360. Command(2) = Command(1)
  361. Command(1) = Origans
  362. Goto main
  363.  
  364. end
  365.  
  366. Procedure Input(VAR STRING Answer,INTEGER MaxLen)
  367. String key
  368. Integer leng,i,x,y
  369.  
  370. let Answer = ""
  371. let leng = 0
  372. ;let i = MaxAd
  373.  
  374. :start
  375. let key = tinkey(0)       ;Why TINKEY(0)? It uses ALOT let CPU time, cuzz the
  376. if (Len(key) > 1) then      ;PPE doesn't have to sit a poll the KBD, PCB does!
  377.  if (key = "UP") then
  378.   If (i < MaxAd) then
  379.    Command(i) = Answer
  380.    i = i + 1
  381.    Backup 80
  382.    Print DirString+Command(i)
  383.    ClrEol
  384.    leng = len(Command(i))
  385.    Answer = Command(i)
  386.   Endif
  387.  Endif
  388.  If (key = "DOWN") then
  389.   If (i > 0) then
  390.    Command(i) = Answer
  391.    i = i - 1
  392.    Backup 80
  393.    Print DirString+Command(i)
  394.    ClrEol
  395.    leng = len(Command(i))
  396.    Answer = Command(i)
  397.   Endif
  398.  Endif
  399. Endif
  400. Command(i) = Answer
  401. if (key = chr(13)) goto End_Input
  402. if (key = chr(29)) goto start
  403. if (key = chr(27)) then
  404.  leng = 0
  405.  Command(i) = ""
  406.  answer = ""
  407.  Backup 80
  408.  Print DirString
  409.  ClrEol
  410.  goto start
  411. endif
  412. if (key = chr(8)) then
  413.     if (leng = 0) goto start
  414.         let leng = leng - 1
  415.         Backup 1
  416.         Print " "
  417.         Backup 1
  418.         let Answer = left(Answer, leng)
  419.         Goto start
  420.     endif
  421. if (!(len(key) = 1)) goto start
  422. if (asc(key) < 31) goto start
  423. if (leng = maxlen) goto start
  424. let Answer = Answer + key
  425. let leng = leng + 1
  426. print "@X08",key
  427. backup 1
  428. delay 1
  429. print "@X07",key
  430. backup 1
  431. delay 1
  432. print "@X0F",key
  433. Goto start
  434. :End_input
  435. Answer = Trim(Command(i)," ")
  436.  
  437. EndProc
  438.  
  439. Function NumToString(Integer thisint) string
  440. int pos
  441. string threenum
  442.  
  443. for pos = 1 to (len(thisint) / 3) + 1
  444.  threenum = Trim(Left(Right(thisint,pos * 3),3)," ")
  445.  if (pos = 1) then
  446.   NumToString = threenum
  447.  else
  448.   if (threenum != "") NumToString = threenum + comma + NumToString
  449.  endif
  450. next pos
  451.  
  452. EndFunc
  453.  
  454. Function CurDir() string
  455.  
  456.  If (!Right(CWD(),1) = "\") then
  457.   CurDir() = CWD() + "\"
  458.  else
  459.   CurDir() = CWD()
  460.  endif
  461.  
  462. EndFunc
  463.