home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / os2apipm.zip / APIEXAM / DIRCH.ADB < prev    next >
Text File  |  1996-07-20  |  3KB  |  79 lines
  1. -- Simple example of  DosQueryCurrentDisk,DosQueryCurrentDir
  2. --                    DosSetDefaultDisk,  DosSetCurrentDir  API OS/2
  3. -- change directory
  4. -- in the end of current directory on path
  5. with os2;use os2;
  6. with os2.fm;use os2.fm;
  7. with os2.err;use os2.err;
  8. with text_io; use text_io;
  9. with builtin; use builtin;
  10. procedure dirch is
  11. zero:constant character:=character'val(0);
  12. ind :integer;
  13. rc:apiret;
  14. lit:character;
  15. l:natural;
  16. path         :string(1..60):=(others=>zero);
  17. ppath        :constant PSZ :=path(4)'address;   --  c:\xxxxx
  18.                                        --  123|
  19.  drive       :aliased ULONG ;     -- driver number  (A=1,B=2   )
  20. pdrive       :PULONG:=drive'unchecked_access;
  21.  map         :aliased ULONG  ;     -- driver map (not used)
  22. pmap         :PULONG:=map'unchecked_access;
  23.  bufflen     :aliased ULONG:=60;  -- buffer size
  24. pbufflen     :PULONG:=bufflen'unchecked_access;
  25. pathbuff     :array(1..60) of aliased byte;
  26. pathbufa     :constant system.address := pathbuff(1)'address ;
  27. ppathbuff    :PBYTE :=pathbuff(1)'unchecked_access;
  28. pathstr      :string(1..60);
  29. for pathstr'address use pathbufa;
  30. ------------------------------------------------------------------------
  31. begin
  32. new_line; put("Enter new path (c:\os2)  => ");   get_line(path,l);
  33. upper_low(path); -- upper string
  34.  
  35. rc:=DosQueryCurrentDisk(pdrive,pmap);  -- curent disk
  36.  
  37. if rc>0 then put_edit("DosQCurDisk error=",integer(rc),4);
  38. put(' '); put(Err_list(integer(rc)));
  39.    goto fin;
  40. end if;
  41.  
  42. rc:=DosQueryCurrentDir(drive,ppathbuff,pbufflen );
  43. if rc>0 then put_edit("DosQCurDir error=",integer(rc),4);
  44. put(' '); put(Err_list(integer(rc))); goto fin;
  45. end if;
  46.  
  47. put("Old directory="); ind:=index(pathstr,zero)-1;
  48. put(left(pathstr,ind));
  49. lit:=path(1);
  50. new_line;
  51. case lit is
  52. when 'A' =>drive:= 1 ; when 'B' =>drive:= 2 ;  when 'C' =>drive:= 3 ; when 'D' =>drive:= 4 ;
  53. when 'E' =>drive:= 5 ; when 'F' =>drive:= 6 ;  when 'G' =>drive:= 7 ; when 'H' =>drive:= 8 ;
  54. when 'I' =>drive:= 9 ; when 'J' =>drive:= 10;  when 'K' =>drive:= 11; when 'L' =>drive:= 12;
  55. when others =>drive:= 3;
  56. end case;
  57. put_edit("New drive number =>",integer(drive),2);
  58. rc:=DosSetDefaultDisk( drive );  -- change drive
  59. if rc=15 then new_line; put("Invalid drive"); goto fin; end if;
  60. if rc>0  then new_line; put_edit("DosSelectDisk error=",integer(rc),4);
  61. put(' '); put(Err_list(integer(rc))); goto fin;
  62. end if;
  63.                       -- directory change
  64. put(" New Drive Ok!");
  65. rc:=DosSetCurrentDir (ppath);
  66. if rc=3 then new_line; put("Invalid directory path"); goto fin; end if;
  67. if rc>0 then new_line; put_edit("DosChDir error=",integer(rc),4);
  68. put(' '); put(Err_list(integer(rc))); goto fin;
  69. end if;
  70.         -- new directory
  71. new_line;
  72. rc:=DosQueryCurrentDir ( drive,ppathbuff,pbufflen );
  73. if rc>0 then  put_edit("DosQCurDir error=",integer(rc),4);
  74. put(' '); put(Err_list(integer(rc))); goto fin;
  75. end if;
  76. put("New directory =>"); ind:=index(pathstr,zero)-1; put(left(pathstr,ind));
  77. <<fin>> null;
  78. end dirch;
  79.