MAKECD.PAS
上传用户:hstrip
上传日期:2007-01-06
资源大小:51k
文件大小:2k
源码类别:

SCSI/ASPI

开发平台:

Pascal

  1. Program MakeCD;
  2. Var
  3. F : File;
  4. I : Word;
  5. S : String;
  6. OK : Boolean;
  7. Tracks : Byte;
  8. Procedure DoWrite(S : String);
  9. Begin
  10. BlockWrite(F,S[1],Length(S));
  11. End;
  12. Begin
  13. If ParamCount<>1 Then Begin
  14. WriteLn('Invalid number of parameters; need filename');
  15. Halt(1);
  16. End;
  17. If ParamStr(1)='/?' Then Begin
  18. WriteLn('Usage: MAKECD filename');
  19. Halt(1);
  20. End;
  21. Assign(F,ParamStr(1));
  22. ReWrite(F,1);
  23. DoWrite(#$00#$00); { Offset of VTOC }
  24. DoWrite(#$FF#$FF); { Offset of Sec16 }
  25. DoWrite(#$00#$00#$08); { Sector size }
  26. DoWrite(#$00#$00#$08#$06); { Volume size }
  27. Write('Enter # of audio tracks: ');
  28. ReadLn(I);
  29. Tracks:=I+1;
  30. DoWrite(#$01);
  31. DoWrite(Chr(Tracks));
  32. DoWrite(#$27#$3B#$46#$00); { Audio disk info }
  33. DoWrite(#$42#$00#$00#$00#$00#$00#$00#$00#$00#$08); { UPC code }
  34. For I:=1 To 3*38 Do
  35. DoWrite(#$00); { Filenames }
  36. Repeat
  37. Write('Enter volume label: ');
  38. ReadLn(S);
  39. If Length(S)>11 Then Begin
  40. OK:=FALSE;
  41. WriteLn('Volume label too long (>11 characters)');
  42. Continue;
  43. End;
  44. For I:=1 To Length(S) Do
  45. S[I]:=UpCase(S[I]);
  46. Ok:=TRUE;
  47. For I:=1 To Length(S) Do
  48. If Not (S[I] In ['A'..'Z','0'..'9','!','@','#','$','%','&','(',')','-','_',
  49. '{','}','''','`','~']) Then Begin
  50. WriteLn('Volume label contains illegal characters');
  51. OK:=FALSE;
  52. End;
  53. Until OK;
  54. S:=S+#0#0#0#0#0#0#0#0#0#0#0; { Volume label }
  55. BlockWrite(F,S[1],12);
  56. DoWrite(#$01#$00); { Sectors/cluster }
  57. DoWrite(#$00#$00); { Free clusters }
  58. DoWrite(#$00#$08); { Bytes/sector }
  59. DoWrite(#$FF#$FF); { Total clusters }
  60. DoWrite(#$01#$01); { Track lo / hi }
  61. While Tracks>0 Do Begin
  62. Dec(Tracks);
  63. DoWrite(#$00#$00#$00#$00#$00); { Track info }
  64. End;
  65. I:=FileSize(F);
  66. Seek(F,0);
  67. BlockWrite(F,I,2);
  68. Seek(F,I);
  69. I:=$FFFF;
  70. BlockWrite(F,I,2); { End of VTOC }
  71. BlockWrite(F,I,2); { Size of VTOC }
  72. DoWrite(#$00#$00); { AX }
  73. DoWrite(#$07#$07); { Flags }
  74. Close(F);
  75. End.