ABBUC Magazin 39A/ABBUC_Magazin_39_19xx_ABBUC_Side_A.atr/xfdtrans.act

Text File | 2023-02-26 | 3KB | 1 lines

;********************************¢;**                            **¢;** Phoenix SoftCrew ACTION!   **¢;** Programme und Tips f. 8Bit **¢;**                            **¢;** Carsten Strotmann          **¢;** Lappenbrink 61             **¢;**                            **¢;** D-48336 Sassenberg         **¢;** (02583) 3621               **¢;**                            **¢;********************************¢¢; Programmname:XFD Transfer   ¢; Programmierer:CS¢; Filename:XFDTRANS.ACT¢; erste Version:09.09.94¢; letzte Aenderung:09.09.94¢; Zweck:Kopiert SD Diskette in ¢;       virtuelle Diskfile fuer ¢;       PC XFormer 2¢; Bemerkung:¢;¢;¢;INCLUDE "SYSTEM.ACT"¢¢MODULE¢¢BYTE drivenum,err,p_read¢CARD maxsec,bytes¢BYTE ARRAY percom($C),¢           buff($1000),¢           txt(40),¢           destfile(40)¢¢INCLUDE "XFDTRANS.INC"¢           ¢PROC Read_Percom ()¢ ¢ err=Sio (drivenum,$52,$40,7,buff,128,1)¢ err=Sio (drivenum,$4E,$40,7,percom,12,0)¢  ¢ maxsec=percom(0)*(percom(2)*$100+percom(3))¢ maxsec==*(percom(4)+1)¢ bytes =percom(6)*$100+percom(7)¢ p_read=err¢¢RETURN¢¢PROC Write_Percom ()¢ ¢ err=Sio (drivenum,$4F,$80,7,percom,12,0)¢ ¢RETURN¢¢PROC CopyDisk()¢¢ BYTE ch=$2FC,consol=$D01F¢ CARD u,b,s,t,a¢¢ Close(2)¢ Open (2,destfile,8,0)¢¢ Read_Percom()¢ Write (0,15,"0.........1.........2.........3........9")¢ Write (5,19,"...ein ACTION! Programm.        ")¢ Write (5,20,"exclusiv fuer ABBCU e.V.        ")¢ ¢ u=0¢ t=0¢ b=bytes¢¢ DO¢  a=buff¢  Write (t,16,"L")¢  FOR s = 1 TO 18 DO¢    u ==+1¢    err=Sio (drivenum,$52,$40,$7,a,b,u)¢    a==+$80¢  OD¢  Write (t,16,"S")¢  Bput (2,buff,$900)¢  Write (t,16,"«")¢  t==+1¢ UNTIL u=maxsec OR ch=28 or consol=6¢ OD¢¢ Pause (200)¢ Write (0,15,"                                        ")¢ Write (0,16,"                                        ")¢ Write (0,19,"                                        ")¢ Write (0,20,"                                        ")¢ ch=$FF¢¢ Close(2)¢¢RETURN¢ ¢PROC Mask ()¢¢ BYTE lmarg=82¢ CARD savmsc=$58¢¢ lmarg=0¢¢ SetBlock (savmsc+120,240,0)¢ ¢ Write (0,0,"áסΦ∩σ∈Θןáצ∩µ⌠ב≥σ≈áןה∩≥ϕσ≥áק≥β∈≤µσ≥ááõ«ãá")¢¢ Write (5,4,"עuell Laufwerk:   (1-9)")¢ StrB (drivenum,txt)¢ Write (21,4,txt)¢¢ Write (5,6,"םieldatei     :")¢ Write (21,6,destfile)¢¢ Write (5,10,"צtarte Kopiervorgang...")¢ Write (5,20,"[ESC] um Programm zu beenden")¢¢ Write (0,23,"áááááá¿π⌐áõ¨¨œáסΦ∩σ∈Θןáצ∩µ⌠ב≥σ≈ááááááááá")¢¢RETURN                   ¢¢¢PROC GetDriveNum()¢¢ C_On()¢ DO¢  Position (21,4)¢  GetIn (txt,1)¢  drivenum =  ValB(txt)¢ UNTIL drivenum > 0 AND drivenum < 9¢ OD¢ C_Off()¢¢RETURN¢¢PROC GetDestFile()¢       ¢ SCopy(destfile,"D8:")¢ Write (21,6,"               ")¢¢ C_On()¢ DO¢  Position (21,6)¢  GetIn (destfile,15)¢ UNTIL destfile(0) > 1¢ OD¢ C_Off()¢¢ Upper(destfile)¢¢RETURN¢¢PROC XFDTrans ()¢¢ BYTE key ¢ BYTE ARRAY value (3)¢¢ drivenum = 1¢ SCopy (destfile,"D8:DISK1.XFD")¢¢ p_read=$FF¢¢ Put (125)¢ C_Off ()¢ Mask ()¢ ¢ DO¢  key=Inkey ()¢¢  IF key = 'Q OR key = 'q THEN¢   GetDriveNum()¢   Mask()¢  FI¢¢  IF key = 'Z OR key = 'z THEN¢   GetDestFile()¢   Mask()¢  FI¢¢  IF key = 'S OR key = 's THEN¢   CopyDisk()¢   Mask()¢  FI¢¢ UNTIL key=27¢ OD¢¢ C_On ()¢¢RETURN¢ ¢