lfn.pas

VB Modem编程及控件

      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      mov dx,si
      mov ax,$713B
      stc
      int $21
      jc @Error
      xor ax,ax
@Error:
      pop ds
      mov @Result,ax
    end;
  end;

  function LFNGetFAttr(FileName : string; var Attr : Word) : Integer;
  begin
    asm
      push ds
      push ss
      pop ds
      lea si,FileName
      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      mov dx,si
      mov ax,$7143
      mov bl,0
      stc
      int $21
      jc @Error
      xor ax,ax
      les di,Attr
      mov es:[di],cx
@Error:
      pop ds
      mov @Result,ax
    end;
  end;

  function LFNSetFAttr(FileName : string; Attr : Word) : Integer;
  begin
    asm
      push ds
      push ss
      pop ds
      lea si,FileName
      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      mov dx,si
      mov ax,$7143
      mov bl,1
      mov cx,Attr
      stc
      int $21
      jc @Error
      xor ax,ax
@Error:
      pop ds
      mov @Result,ax
    end;
  end;

  function LFNGetDir(Drive : Byte; var DirName : string) : Integer;
  assembler;
  asm
    push ds
    mov dl,Drive
    lds si,DirName
    mov di,si               {save start of string}
    inc si                  {leave space for length byte}
    mov al,dl
    dec al                  {al=0 -> 'A', etc.}
    or  dl,dl
    jnz @DriveKnown
    mov ah,$19              {get default drive}
    int $21
@DriveKnown:
    add al,'A'
    cld
    mov [si],al             {store drive letter}
    inc si
    mov Word ptr [si],'\:'  {store root directory}
    inc si
    inc si
    mov byte ptr [si],0     {store null just in case}
    mov ax,$7147
    stc
    int $21                 {get current directory}
    jc @Error
    xor ax,ax
@Error:
    mov si,di               {save start of string again}
    push ds
    pop es
    inc di
    mov cx,255
    repne scasb             {look for null}
    sub di,si
    mov bx,di
    dec bx
    dec bx
    mov [si],bl             {store length}
    pop ds
  end;

  function AsciiLen(const S : string; MaxLen : Word) : Word;
  var
    I : Word;
  begin
    I := 1;
    while S[I] <> #0 do
      inc(I);
    dec(I);
    if I > MaxLen then
      I := MaxLen;
    AsciiLen := I;
  end;

  procedure LFNFixSearchRec(var SR : TLFNSearchRec);
  begin
    move(SR.Name[0], SR.Name[1], 255);
    Byte(SR.Name[0]) := AsciiLen(SR.Name, 255);
    move(SR.AltName[0], SR.AltName[1], 13);
    Byte(SR.AltName[0]) := AsciiLen(SR.AltName, 13);
  end;

  function LFNFindFirst(Path : string;
                        ReqdAttr : Byte; Attr : Byte;
                        var SR : TLFNSearchRec) : Integer;
  begin
    asm
      push ds
      push ss
      pop ds
      lea si,Path
      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      mov dx,si
      mov ch,ReqdAttr
      mov cl,Attr
      mov ax,$714E
      les di,SR
      mov si,1               {MS-DOS format for date and time}
      stc
      int $21
      mov bx,ax              {save error code}
      jc @Error
      xor bx,bx              {clear error code}
      mov TLFNSearchRec(es:[di]).ConversionCode,cx {Unicode conversion status}
      mov TLFNSearchRec(es:[di]).Handle,ax {search handle}
      pop ds
      push bx
      push es
      push di
      call LFNFixSearchRec
      pop bx
      push ds
@Error:
      pop ds
      mov @Result,bx
    end;
  end;

  function LFNFindNext(var SR : TLFNSearchRec) : Integer; assembler;
  asm
    les di,SR
    mov byte ptr TLFNSearchRec(es:[di]).AltName,0
    mov bx,TLFNSearchRec(es:[di]).Handle
    mov si,1              {MS-DOS format for date and time}
    mov ax,$714F
    stc
    int $21
    jc @Error
    xor ax,ax
    mov TLFNSearchRec(es:[di]).ConversionCode,cx {Unicode conversion status}
    push ax
    push es
    push di
    call LFNFixSearchRec
    pop ax
@Error:
  end;

  procedure LFNFindClose(var SR : TLFNSearchRec); assembler;
  asm
    les di,SR
    mov bx,TLFNSearchRec(es:[di]).Handle
    mov ax,$71A1
    stc
    int $21
    jc @Error
    xor ax,ax
@Error:
  end;

  function LFNRename(OldName, NewName : string) : Integer;
  begin
    asm
      push ds
      push ss
      pop ds
      lea si,OldName
      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      mov dx,si
      push ss
      pop es
      lea di,NewName
      mov bl,es:[di]         {bx = length}
      inc di                 {di points to first actual character}
      mov byte ptr es:[bx+di],0 {null-terminate}
      mov ax,$7156
      stc
      int $21
      jc @Error
      xor ax,ax
@Error:
      pop ds
      mov @Result,ax
    end;
  end;

  function LFNGetPath(ExpandSubst : Boolean; FullPathMode : Byte;
                      SrcName : string; var DestName : string) : Integer;
  begin
    asm
      push ds
      mov cl,FullPathMode
      mov ch,ExpandSubst
      or ch,ch
      jz @HaveSubst
      mov ch,$80
  @HaveSubst:
      push ss
      pop ds
      lea si,SrcName
      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      les di,DestName
      inc di                 {di points to first actual character}
      mov ax,$7160
      stc
      int $21
      jc @Error
      xor ax,ax
      les di,DestName        {find and store length}
      mov si,di
      inc di
      cld
      mov cx,255
      repne scasb
      sub di,si
      mov bx,di
      dec bx
      dec bx
      mov es:[si],bl
@Error:
      pop ds
      mov @Result,ax
    end;
  end;

  function LFNGetFullPath(ExpandSubst : Boolean;
                          const SrcName : string;
                          var DestName : string) : Integer;
  begin
    LFNGetFullPath := LFNGetPath(ExpandSubst, 0, SrcName, DestName);
  end;

  function LFNGetShortPath(ExpandSubst : Boolean;
                           const SrcName : string;
                           var DestName : string) : Integer;
  begin
    LFNGetShortPath := LFNGetPath(ExpandSubst, 1, SrcName, DestName);
  end;

  function LFNGetLongPath(ExpandSubst : Boolean;
                          const SrcName : string;
                          var DestName : string) : Integer;
  begin
    LFNGetLongPath := LFNGetPath(ExpandSubst, 2, SrcName, DestName);
  end;

  function LFNGetVolumeInfo(RootName : string;
                            var FileSysName : string;
                            var FileSysFlags : Word;
                            var MaxNameLen : Word;
                            var MaxPathLen : Word) : Integer;
  begin
    asm
      push ds
      push ss
      pop ds
      lea si,RootName
      mov bl,[si]
      xor bh,bh              {bx = length}
      inc si                 {si points to first actual character}
      mov byte ptr [bx+si],0 {null-terminate}
      mov dx,si
      les di,FileSysName
      inc di
      mov cx,256
      mov ax,$71A0
      stc
      int $21
      jc @Error
      xor ax,ax
      lds si,FileSysFlags
      mov [si],bx
      lds si,MaxNameLen
      mov [si],cx
      lds si,MaxPathLen
      mov [si],dx
      les di,FileSysName
      mov si,di
      inc di
      cld
      mov cx,255
      repne scasb
      sub di,si
      mov bx,di
      dec bx
      dec bx
      mov bx,di
      mov es:[si],bl
@Error:
      pop ds
      mov @Result,ax
    end;
  end;

  function LFNParamCount : Word;
  var
    PS : ^string;
    EPos : Word;
    SPos : Word;
    Index : Word;
    InQuote : Boolean;
  begin
    Index := 0;

    InQuote := False;
    PS := Ptr(PrefixSeg, $80);

    for EPos := 1 to Length(PS^)+1 do begin
      case PS^[EPos] of
        ' ', ^M :
          if InQuote then begin
            if EPos = SPos then
              inc(Index);
          end else
            SPos := EPos+1;
        '"' :
          begin
            if InQuote then begin
              InQuote := False;
              if EPos = SPos then
                inc(Index);
            end else
              InQuote := True;
            SPos := EPos+1;
          end;
      else
        if EPos = SPos then
          inc(Index);
      end;
    end;

    LFNParamCount := Index;
  end;

  function LFNParamStr(Index : Word) : string;
  label
    Found;
  var
    PS : ^string;
    EPos : Word;
    SPos : Word;
    InQuote : Boolean;
  begin
    if Index = 0 then begin
      LFNParamStr := ParamStr(0);
      Exit;
    end;

    LFNParamStr := '';
    InQuote := False;
    PS := Ptr(PrefixSeg, $80);

    for EPos := 1 to Length(PS^)+1 do begin
      case PS^[EPos] of
        ' ', ^M :
          if InQuote then begin
            if EPos = SPos then
              dec(Index);
          end else if Index = 0 then
            goto Found
          else
            SPos := EPos+1;
        '"' :
          begin
            if InQuote then begin
              InQuote := False;
              if EPos = SPos then
                dec(Index);
            end else
              InQuote := True;
            if Index = 0 then
              goto Found;
            SPos := EPos+1;
          end;
      else
        if EPos = SPos then
          dec(Index);
      end;
    end;

    if Index = 0 then
Found:
      LFNParamStr := copy(PS^, SPos, EPos-SPos);
  end;

end.