Home » Source Code » » DATEIEN.PAS

DATEIEN.PAS ( File view )

From:
  • By 2010-07-21
  • View(s):9
  • Download(s):0
  • Point(s): 1
			{
$UNDEF test
}
{
$IFDEF test
}
  PROGRAM dateien;
  {
$A+,B-,D+,E-,F-,G-,I+,L+,N-,O-,R+,S+,V-,X-
}
  {
$M 32768,0,655360
}
{
$ELSE
}
  unit dateien;
  {
$A+,B-,D+,E-,F-,G-,I-,L+,N-,O-,R-,S+,V-,X-
}
  {
$M 32768,150000,655360
}

{
Zweck    : Stellt eine komfortable Dateiauswahlschachtel fr die    
}
{
           Auswahl einzelner oder mehrerer Dateien zur Verfgung    
}
{
Autor    : Kai Rohrbacher    
}
{
Sprache  : TurboPascal 6.0   
}
{
Datum    : 17.09.1992        
}
{
Anmerkung: Arbeitet dynamisch und mit allen Textmodi                
}

interface
{
$ENDIF
}
USES crt,dos,eingaben;

type TArt=(Laufwerk,Verzeichnis,Datei);
     TPath =String[67];
     TName =String[8];
     TPunkt=CHAR;
     TExten=String[3];
     TAlles=STRING[8+1+3];
     TSize =LONGINT;
     TDate =LONGINT;
     PDateiName=^Dateiname;
     Dateiname=
       RECORD
        next:PDateiName;
        art:TArt;
        size:TSize;
        date:TDate;
        Vorname:TName; Punkt:TPunkt; Nachname:TExten;
        ganz:TAlles;
       END;

TYPE VideoMem=ARRAY[0..32766] OF WORD;
VAR ScreenX,ScreenY:BYTE; {
enthalten aktuelle Auflsung, z.B. 80 und 43
}
    Basis:^VideoMem;      {
zeigt auf Pos. (0,0) der akt. Textseite
}

VAR  Laufwerke:String;  {
Laufwerke im System, wird noch ergnzt!
}

{
$IFNDEF test
}
 PROCEDURE Auswahl(x,y,MaxZeilen:BYTE; Header:STRING;
                   list:PDateiname; listlen:WORD;
                   nur_eins:BOOLEAN; VAR last,sel:PDateiname;
                   VAR CursSelected:BOOLEAN);
 PROCEDURE MakeFileList(VAR p:TPath; typ:STRING;
                        VAR list:PDateiName; VAR listlen:WORD;
                        VAR error:BOOLEAN);
 FUNCTION ChooseSingleFile(xpos,ypos,max_zeilen:BYTE;
                           Pf:TPath; typ:STRING; VAR error:BOOLEAN):TPath;
 FUNCTION ChooseMultipleFiles(xpos,ypos,max_zeilen:BYTE;
                              VAR Pfad:TPath; typ:STRING;
                              VAR error:BOOLEAN):PDateiname;
 PROCEDURE StripBlanks(VAR s:TAlles);
 PROCEDURE DelList(VAR list:PDateiName);
 FUNCTION UpString(St:String):STRING;
 FUNCTION LoString(St:String):STRING;
 PROCEDURE Rahmen(x1,y1,x2,y2:byte);
 PROCEDURE DetectXYresolution(VAR x,y:BYTE);
 FUNCTION BaseAddress:POINTER;
 PROCEDURE OutCharXY(x,y:BYTE; ch:WORD);
 FUNCTION GetCharXY(x,y:BYTE):WORD;
 PROCEDURE OutStringXY(x,y,attr:BYTE; s:STRING);
 FUNCTION min(x,y:INTEGER):INTEGER;
 FUNCTION max(x,y:INTEGER):INTEGER;
 FUNCTION BIOSreadKey:WORD;
 FUNCTION Festplatten_im_System:String;

implementation
{
$ENDIF
}

CONST SelUnsel:InputString='*.*'; {
Suchmaske bei "+","-"; Ersatz fr "STATIC"
}
VAR oldx,oldy,attr:BYTE;
    oldDir:TPath;

{
---------- Routinen fr exotische Bildschirmmodi------------
}

 PROCEDURE DetectXYResolution(VAR x,y:BYTE); ASSEMBLER;
 {
 in: - 
}
 {
out: x = Anzahl Spalten des aktuellen Videomodus
}
 {
     y = dto., Zeilen
}
 ASM
  PUSH BP

  MOV DL,24
  XOR BH,BH
  MOV AX,$1130
  INT $10
  MOV AH,$F
  INT $10
  INC DL

  POP BP

  LES DI,x
  MOV AL,AH
  STOSB
  LES DI,y
  MOV AL,DL
  STOSB
 END;

 FUNCTION BaseAddress:POINTER; ASSEMBLER;
 {
out: Zeiger auf 1.Byte der aktuellen Textseite
}
 {
rem: Mono-/Farbgrafikadapter, exotische Auflsungen
}
 {
     und mehrere Bildschirmseiten werden bercksichtigt!
}
 ASM
  PUSH DS
  PUSH BP

  MOV AH,$F
  INT $10   {
danach: BH=Display page 
}
  MOV AH,3
  INT $10   {
danach: DH/DL=Cursor Y/X
}
  PUSH DX   {
merken!
}

  MOV AH,2
  XOR DX,DX
  INT $10   {
Cursor ist jetzt bei Pos. (0,0)
}

  MOV AH,8
  INT $10   {
Zeichen von dort lesen: AL/AH=ASCII/Attr.
}
  PUSH AX   {
merken!
}

  XOR SI,SI
  MOV DS,SI
  MOV SI,$44E
  MOV DI,[SI]  {
DI=Pageoffset der aktuellen Seite
}
  MOV SI,$B800 {
Farbsegment ausprobieren
}
  MOV ES,SI    {
ES:DI=^Pos(0,0) der akt. Seite, wenn Farbmonitor
}
  NEG AX    {
Zeichen verndert zurckschreiben
}
  STOSW

  MOV AH,2
  XOR DX,DX
  INT $10   {
Cursor ist jetzt wieder bei Pos. (0,0)
}

  MOV AH,8
  INT $10   {
Zeichen prflesen: in AL/AH
}
  POP CX    {
altes Zeichen
}
  POP DX    {
alte Cursorposition
}
  CMP AX,CX {
vergleiche Zeichen mit altem
}
  PUSHF     {
Ergebnis merken
}
  PUSH CX   {
altes Zeichen wird nochmal gebraucht
}

  MOV AH,9
  MOV AL,CL
  MOV BL,CH
  MOV CX,1
  INT $10   {
altes Zeichen zurck nach Pos(0,0) schreiben
}

  MOV AH,2
  INT $10   {
Cursor ist jetzt wieder an alter Stelle
}

  XOR SI,SI
  MOV DS,SI
  MOV SI,$44E
  MOV DI,[SI]  {
DI=Pageoffset der aktuellen Seite
}
  MOV SI,$B800 {
Farbsegment
}
  MOV ES,SI    {
ES:DI=^Pos(0,0) der akt. Seite
}
  POP AX       {
altes Zeichen zurckschreiben
}
  MOV ES:[DI],AX

  POPF      {
Vergleichsergebnis von vorhin
}

  POP BP
  POP DS

  JE @monochrom
  MOV DX,$B800
  JMP @offset
 @monochrom:
  MOV DX,$B000
 @offset:
  MOV AX,DI
 END;

 PROCEDURE OutCharXY(x,y:BYTE; ch:WORD);
 {
 in: (x,y) = Bildschirmposition fr auszugebendes Zeichen
}
 {
     ch = auszugebendes Zeichen, inklusive Attribut, in  
}
 {
          der Form "Farbe SHL 8 +Ord(Zeichen)"
}
 {
     Basis = Zeiger auf Pos. (0,0) des Schirms
}
 {
     ScreenX = horizontale Auflsung des Bildschirms
}
 {
     ScreenY = dto., vertikal
}
 {
rem: Die Cursorposition wurde durch OutCharXY() nicht weitergesetzt!
}
 BEGIN
  Basis^[(ScreenX*Pred(y) +Pred(x))]:=ch
 END;

 FUNCTION GetCharXY(x,y:BYTE):WORD;
 {
 in: (x,y) = Bildschirmposition des auszulesenden Zeichens
}
 {
     Basis = Zeiger auf Pos. (0,0) des Schirms
}
 {
     ScreenX = horizontale Auflsung des Bildschirms
}
 {
     ScreenY = dto., vertikal
}
 {
out: vom Bildschirm gelesenens Zeichen, inklusive Attribut, in
}
 {
     der Form "Farbe SHL 8 +Ord(Zeichen)"
}
 BEGIN
  GetCharXY:=Basis^[(ScreenX*Pred(y) +Pred(x))]
 END;

 PROCEDURE OutStringXY(x,y,attr:BYTE; s:STRING);
 {
 in: (x,y) = Bildschirmposition fr auszugebendes Zeichen
}
 {
     attr  = Attribut fr Stringzeichen
}
 {
     s = auszugebende Zeichen
}
 {
     Basis = Zeiger auf Pos. (0,0) des Schirms
}
 {
     ScreenX = horizontale Auflsung des Bildschirms
}
 {
     ScreenY = dto., vertikal
}
 {
rem: Die Cursorposition wurde durch OutStringXY() nicht weitergesetzt!
}
 VAR i:BYTE;
     offs:WORD;
 BEGIN
  offs:=ScreenX*Pred(y) +Pred(x);
  FOR i:=1 TO Length(s) DO
   Basis^[offs +Pred(i)]:=attr SHL 8 +BYTE(s[i])
 END;

{
------------------------------------------------------------
}

 PROCEDURE StripBlanks(VAR s:TAlles);
 VAR i:BYTE;
 BEGIN
  FOR i:=length(s) DOWNTO 1 DO
   IF s[i]=' ' THEN Delete(s,i,1)
 END;

 FUNCTION min(x,y:INTEGER):INTEGER;
 BEGIN
  IF x<=y THEN min:=x ELSE min:=y
 END;

 FUNCTION max(x,y:INTEGER):INTEGER;
 BEGIN
  IF x>=y THEN max:=x ELSE max:=y
 END;

 FUNCTION BIOSreadKey:WORD; ASSEMBLER;
 {
rem: Wird bentigt, da ReadKey() keine Scancodes zurckliefert
}
 ASM
  MOV AH,0
  INT $16
 END;

 FUNCTION UpString(St:STRING):STRING;
 VAR i:byte;
 BEGIN
  FOR i:=1 TO length(st) DO
   Case St[i] OF
    '':St[i]:='';
    '':St[i]:='';
    '':St[i]:='';
    else St[i]:=Upcase(St[i]);
   END;
  UpString:=St
 END;

 FUNCTION LoString(St:STRING):STRING;
 VAR i:BYTE;
 BEGIN
  FOR i:=1 TO length(st) DO
   Case St[i] OF
    '':St[i]:='a';
    '':St[i]:='';
    '':St[i]:='';
    'A'..'Z':St[i]:=CHAR(BYTE(St[i]) OR $20);
   END;
  LoString:=St
 END;

 FUNCTION Festplatten_im_System:String;
 {
in : - 
}
 {
out: String mit Namen der angeschlossenen
}
 {
     Festplatten, z.B.: 'CD'             
}
 VAR Laufwerk,Id_Byte,Code:Byte;
     s:String;
 BEGIN
  s:='';
  Laufwerk:=3;
  REPEAT
  INLINE(
    $8A/$56/255) and (ID_Byte=$F8)
    THEN s:=s+chr(64+Laufwerk);
   INC(Laufwerk);
  UNTIL (Code=255) or (Laufwerk>26);
  Festplatten_im_System:=s;
 END;


 PROCEDURE Rahmen(x1,y1,x2,y2:byte);
 VAR i:byte;
 BEGIN
  OutCharXY(x1,y1,TextAttr SHL 8 +218);
  FOR i:=x1+1 TO x2-1 DO OutCharXY(i,y1,TextAttr SHL 8 +196);
  OutCharXY(x2,y1,TextAttr SHL 8 +191);
  FOR i:=y1+1 TO y2-1 DO
   BEGIN
    OutCharXY(x1,i,TextAttr SHL 8 +179);
    OutCharXY(x2,i,TextAttr SHL 8 +179);
   END;
  OutCharXY(x1,y2,TextAttr SHL 8 +192);
  FOR i:=x1+1 TO x2-1 DO OutCharXY(i,y2,TextAttr SHL 8 +196);
  OutCharXY(x2,y2,TextAttr SHL 8 +217)
 END;

 PROCEDURE DelList(VAR list:PDateiName);
 VAR p:PDateiName;
 BEGIN
  WHILE list<>NIL DO
   BEGIN
    p:=list;
    list:=list^.next;
    dispose(p)
   END;
 END;

 FUNCTION LeadingChars(t:WORD; ch:CHAR; n:BYTE):STRING;
 {
Wandelt t in STRING und fllt ihn vorn auf n Stellen mit ch auf
}
 VAR s:STRING;
     i:BYTE;
 BEGIN
  STR(t,s);
  FOR i:=succ(length(s)) TO n DO insert(ch,s,1);
  LeadingChars:=s
 END;

{
$IFDEF test
}
 PROCEDURE WriteEntry(x,y:BYTE; p:DateiName);
 VAR t:DateTime;
 BEGIN
  GotoXY(x,y);
  WITH p DO
   BEGIN
    WRITE(ganz,'');
    CASE art OF
     Datei: IF size<1E9
             THEN WRITE(size:8,'') {
pat ins Feld
}
             ELSE WRITE(LeadingChars((size DIV 1024),' ',7)+'K','');
     Laufwerk:WRITE(#16+' DISK '+#17,'');
     Verzeichnis:IF pos('..',Vorname)=0
                  THEN WRITE(#16+'SUBDIR'+#17,'')
                  ELSE WRITE(#16+'UP-DIR'+#17,'')
    END;
    IF art<>Laufwerk
     THEN BEGIN
           UnpackTime(Date,t);
           WRITE(LeadingChars(t.day,'0',2),'.',
                 LeadingChars(t.month,'0',2),'.',
                 LeadingChars(t.year,'0',4),
                 '',
                 LeadingChars(t.hour,'0',2),':',
                 LeadingChars(t.min,'0',2));
          END
     ELSE WRITE('          ','','     ');
   END;
 END;

 PROCEDURE WriteList(list:PDateiName);
 VAR y:BYTE;
 BEGIN
  y:=1;
  WHILE list<>NIL DO
   BEGIN
    WriteEntry(1,y,list^);
    l
...
...
(Not finished, please download and read the complete file)
			
...
Expand> <Close

Want complete source code? Download it here

Point(s): 1

Download
0 lines left, continue to read
Sponsored links

File list

Tips: You can preview the content of files by clicking file names^_^
Name Size Date
ANIVGA.DOC220.35 kB07-11-93|18:45
ANIVGA.ENG320.98 kB07-11-93|18:45
ANIVGA.PAS318.61 kB07-11-93|18:45
ANIVGA.TUT12.66 kB07-11-93|18:45
BFFFFFFF.PAS2.02 kB07-11-93|18:45
CHANGES.TXT4.76 kB07-11-93|18:45
COMPRESS.PAS38.98 kB07-11-93|18:45
DATEIEN.PAS45.08 kB07-11-93|18:45
DUMP_SPR.PAS10.05 kB07-11-93|18:45
EINGABEN.PAS8.68 kB07-11-93|18:45
EXAMPL12.PAS3.77 kB07-11-93|18:45
EXAMPLE1.PAS1.58 kB07-11-93|18:45
EXAMPLE2.PAS1.89 kB07-11-93|18:45
EXAMPLE3.PAS3.24 kB07-11-93|18:45
EXAMPLE4.PAS1.64 kB07-11-93|18:45
EXAMPLE5.PAS2.92 kB07-11-93|18:45
EXAMPLE6.PAS3.98 kB07-11-93|18:45
EXAMPLE7.PAS3.03 kB07-11-93|18:45
EXAMPLE8.PAS2.82 kB07-11-93|18:45
EXAMPLE9.PAS1.38 kB07-11-93|18:45
FAQ.TXT11.99 kB07-11-93|18:45
07.00 B
2_HEBREW.FNT3.51 kB11-03-92|10:38
30.FNT3.26 kB11-03-92|10:39
33Q.FNT3.01 kB11-03-92|10:39
36.FNT2.76 kB11-03-92|10:39
44.FNT2.26 kB11-03-92|10:39
8X10.FNT2.51 kB11-03-92|10:38
8X11SNSF.FNT2.76 kB11-03-92|10:38
8X14.FNT3.51 kB11-03-92|10:38
ALPS.FNT3.51 kB11-03-92|10:37
ALPS10.FNT2.51 kB11-03-92|10:37
ALPS11.FNT2.76 kB11-03-92|10:37
ALPS6.FNT1.51 kB11-03-92|10:37
ALPS7.FNT1.76 kB11-03-92|10:37
ALPS8.FNT2.01 kB11-03-92|10:37
ANTIQUE.FNT3.51 kB11-03-92|10:38
APLS9.FNT2.26 kB11-03-92|10:37
B814.FNT3.51 kB11-03-92|10:39
BIGSERIF.FNT3.51 kB11-03-92|10:38
BLCKSNSF.FNT2.51 kB11-03-92|10:38
BLOCK.FNT3.51 kB11-03-92|10:38
BOLD.FNT3.51 kB11-03-92|10:38
BROADWAY.FNT3.51 kB11-03-92|10:38
CNTDOWN.FNT3.51 kB11-03-92|10:37
COMPUTER.FNT3.51 kB11-03-92|10:38
COURIER.FNT3.51 kB11-03-92|10:38
CYRILLIC.FNT3.51 kB11-03-92|10:38
DEFAULT.FNT1.51 kB11-03-92|10:39
FIRE.FNT52.26 kB11-03-92|18:45
FIRE.PAL768.00 B11-03-92|18:45
FRANKFRT.FNT3.51 kB11-03-92|10:37
FRESNO.FNT3.51 kB11-03-92|10:38
FUTURE.FNT3.51 kB11-03-92|10:38
GAELIC.FNT3.51 kB11-03-92|10:37
GEORGIAN.FNT3.51 kB11-03-92|10:37
GREEK.FNT3.51 kB11-03-92|10:38
HOLLOW.FNT3.51 kB11-03-92|10:38
HUGE.FNT4.01 kB11-03-92|10:39
HYLAS.FNT3.51 kB11-03-92|10:38
ITALIC.FNT3.51 kB11-03-92|10:37
ITALICS.FNT3.51 kB11-03-92|10:37
ITT.FNT3.51 kB11-03-92|10:38
LCD.FNT3.51 kB11-03-92|10:38
MEDIEVAL.FNT3.51 kB11-03-92|10:38
MODERNFO.FNT4.01 kB11-03-92|10:39
OCR.FNT3.51 kB11-03-92|10:37
OLDENG.FNT3.51 kB11-03-92|10:37
ROMAN.FNT3.51 kB11-03-92|10:39
SANSERIF.FNT3.51 kB11-03-92|10:39
SCRIBBLE.FNT4.01 kB11-03-92|10:39
SCRIPT.FNT3.51 kB11-03-92|10:37
SCRIPT2.FNT3.51 kB11-03-92|10:39
SENAPL.FNT3.51 kB11-03-92|10:37
SIDE.FNT2.51 kB11-03-92|10:37
SIMILITE.FNT3.51 kB11-03-92|10:39
SMALCAPS.FNT3.51 kB11-03-92|10:39
STRETCH.FNT3.51 kB11-03-92|10:39
SUPER.FNT2.01 kB11-03-92|10:39
THAI.FNT3.51 kB11-03-92|10:39
THIN.FNT3.51 kB11-03-92|10:39
THIN8X8.FNT2.01 kB11-03-92|10:39
_BROADWA.FNT8.01 kB11-02-92|12:06
_OCR.FNT3.51 kB11-03-92|10:39
GRAB.EXE14.53 kB07-11-93|18:45
GRAB.PAS45.71 kB07-11-93|18:45
07.00 B
AEGYPTEN.COD1.30 kB06-12-92|21:42
BLACK.COD434.00 B06-12-92|21:54
FLOWER.COD3.26 kB03-20-92|14:04
FRACTAL.PAL768.00 B07-03-93|16:12
FRACTAL1.PIC62.50 kB07-03-93|16:12
FRACTAL2.PIC62.50 kB07-03-93|16:13
FRACTAL3.PIC62.50 kB07-03-93|16:13
FRACTAL4.PIC62.50 kB07-03-93|16:14
HANTEL.LIB4.77 kB11-10-91|15:20
MARMOR.COD8.80 kB06-13-92|18:38
RANDOM.PAL768.00 B07-17-92|19:31
TILE2.COD1.30 kB10-20-91|13:57
WHATSNEW.LIB1.72 kB06-12-93|20:09
07.00 B
APPLE.COD290.00 B10-02-92|05:34
ESP.COD4.55 kB10-05-92|15:06
GAME.EXE43.13 kB07-04-93|12:21
GAME.PAS12.00 kB07-04-93|13:46
LINE.COD1.02 kB09-25-92|18:55
MUSIC.PAS20.14 kB09-24-92|16:52
MUSIC.TPU4.89 kB07-04-93|12:21
QUEST.LIB4.53 kB10-05-92|15:51
README.TXT549.00 B07-04-93|13:47
SMALLNUM.LIB13.00 kB09-27-92|16:24
SPOOK.LIB3.57 kB10-02-92|07:36
STANDARD.PAL768.00 B09-25-92|18:53
MAKE.BAT165.00 B07-11-93|18:45
MAKES.PAS218.08 kB07-11-93|18:45
PCX2COD.DOC852.00 B07-11-93|18:45
PCX2COD.PAS77.98 kB07-11-93|18:45
README.1ST2.87 kB07-11-93|18:45
README.2ND4.12 kB07-11-93|18:45
SHOWPIC.PAS995.00 B07-11-93|18:45
SVGA256.BGI6.19 kB07-11-93|18:45
UNCHAIN.ASM11.60 kB07-11-93|18:45
UNCHAIN.EXE1.20 kB07-11-93|18:45
UNLIB.PAS5.86 kB07-11-93|18:45
WHATSNEW.EXE37.36 kB07-11-93|18:45
WHATSNEW.PAS9.10 kB07-11-93|18:45
...
Sponsored links

DATEIEN.PAS (678.56 kB)

Need 1 point
Your Point(s)

Your Point isn't enough.

Get point immediately by PayPal

More(Debit card / Credit card / PayPal Credit / Online Banking)

Submit your source codes. Get more point

LOGIN

Don't have an account? Register now
Need any help?
Mail to: support@codeforge.com

切换到中文版?

CodeForge Chinese Version
CodeForge English Version

Where are you going?

^_^"Oops ...

Sorry!This guy is mysterious, its blog hasn't been opened, try another, please!
OK

Warm tip!

CodeForge to FavoriteFavorite by Ctrl+D