Code snippets

C:Safer strncpy/cat

EXTERN_C char*
strncatz( char* strDest, const char* strSource, size_t count);

EXTERN_C char*
strncpyz( char* strDest, const char* strSource, size_t count);

#ifdef _WIN32
EXTERN_C wchar_t*
wcsncatz( wchar_t* strDest, const wchar_t* strSource, size_t count);

EXTERN_C wchar_t*
wcsncpyz( wchar_t* strDest, const wchar_t* strSource, size_t count);

#endif

#ifdef _UNICODE
#define _tcsncatz wcscatz
#define _tcsncpyz wcscpyz
#else
#define _tcsncatz strcatz
#define _tcsncpyz strcpyz
#endif

char* strncatz( char* strDest, const char* strSource, size_t count)
/* safe strcat (always zero-terminated ) */
{
const int length = strlen(strDest);
char* lpsz = strncat(strDest, strSource, count - length - 1);
lpsz[count - 1] = _T('\0');
return lpsz;
}

char* strncpyz( char* strDest, const char* strSource, size_t count)
/* safe strcpy (always zero-terminated ) */
{
char* lpsz = strncpy(strDest, strSource, min(strlen(strSource) + 1, count) );
lpsz[count - 1] = _T('\0');
return lpsz;
}

#ifdef _WIN32
wchar_t* wcsncatz( wchar_t* strDest, const wchar_t* strSource, size_t count)
/* safe strcat (always zero-terminated ) */
{
const int length = wcslen(strDest);
wchar_t* lpsz = wcsncat(strDest, strSource, count - length - 1);
lpsz[count - 1] = _T('\0');
return lpsz;
}

wchar_t* wcsncpyz( wchar_t* strDest, const wchar_t* strSource, size_t count)
/* safe strncpy (always zero-terminated ) */
{
wchar_t* lpsz = wcsncpy(strDest, strSource, min(wcslen(strSource) + 1, count) );
lpsz[count - 1] = _T('\0');
return lpsz;
}
#endif

Borland Pascal:File object

Unit TFileUnt;

Interface

  Uses
    Objects, Dos, Crt;

  Type
    ByteFile = File Of Byte;
    PDateTime = ^DateTime;
    Str2  = String[2];
    Str80 = String[80];
    sz3   = Array [0..   2] Of Char;
    sz512 = Array [0.. 511] Of Char;

  Const
    FILE_MODE_CREATE    = 1;
    FILE_MODE_READ      = 2;
    FILE_MODE_WRITE     = 4;
    FILE_MODE_READWRITE = 6;

    FILE_SEEK_END = 1;   { End of file }
    FILE_SEEK_CUR = 2;   { Current position of file pointer }
    FILE_SEEK_SET = 3;   { Beginning of file }

  Type
    TFile = Object(TObject)
      private
        m_hfile       : ByteFile;
        m_bOpen       : Boolean;
        m_bFromHandle : Boolean;
        m_sFileName   : PathStr;
        m_nOpenFlags  : Word;
        m_nError      : Integer;
        m_bIOError    : Boolean; { IOResult or DOSError error }
      public
        { Construction / Destruction }
        Constructor Init;
        Destructor  Done; Virtual;
        Function  Open   (sFileName : PathStr; nOpenFlags : Word) : Boolean; Virtual;
        Function  Close : Boolean;

        { I/O }
        Function  Read    (pDest : Pointer; nByteCount : Word) : Word;
        Function  Write   (pSrc  : Pointer; nByteCount : Word) : Word; Virtual;

        { Misc. helpers }
        Function  Remove : Boolean;
        Function  Rename(sNewName : PathStr) : Boolean;
        Function  Seek(nByteCount : LongInt; nOffset : Integer) : Boolean;
        Function  GetSize : LongInt;
        Function  GetPos : LongInt;
        Function  SetTime(dt    : DateTime ) : Boolean;
        Function  GetTime(pDest : PDateTime) : Boolean;
        Function  GetName  : PathStr;
        Function  GetDrive : Char;
        Function  IsError : Boolean;
        Function  GetError : Integer;
      private
        Function  SetError(bIOError : Boolean) : Boolean;
    End;

    TIncFile = Object(TFile)
      private
        m_nInc        : LongInt;
      public
        Constructor Init(nInc : LongInt);
        Function  Open(sFileName : PathStr; nOpenFlags : Word) : Boolean; Virtual;
        Function  Write(pSrc  : Pointer; nByteCount : Word) : Word; Virtual;
        Function  GetInc : LongInt;
        Procedure DoIncrement;
    End;

    TTextFile = Object(TFile)
       public
         Procedure WriteStr(s : String);
         Procedure WriteLn (s : String);
         Procedure WriteStrZ(psz : PChar);
         Procedure WriteLnZ (psz : PChar);
         Function  ReadLn : Str80;
    End;

  Function  IsDrivePresent (d : char) : Boolean;
  Function  IsDriveReadOnly(d : char) : Boolean;
  Function  GetDriveFree   (d : char) : LongInt;   { d = #0 -> default drive  }
  Function  RemoveFile(sFileName : PathStr) : Boolean; { wildcards ok }
  Function  CopyFile(sDest, sSrc : PathStr) : Boolean;
  Function  MoveFile(sDest, sSrc : PathStr) : Boolean; { smart - renames if on same drive }
  Function  SetFileTime(sFileName : PathStr; dt    : DateTime ) : Boolean;
  Function  GetFileTime(sFileName : PathStr; pDest : PDateTime) : Boolean;
  Function  FileExists(sFileName : PathStr): Boolean;

  { helpers }
  Function memset(pDest : Pointer; c : Integer; nCount : Word) : Pointer;
  Function memmove(pDest, pSrc : Pointer; nCount : Word) : Pointer;
  Function UpperCaseStr(s : Str80) : Str80;
  Function UpperCaseChar(c : char) : char;

Implementation

Uses
  Strings;

Const
  PASCAL_FILE_MODE_READ      = 0;
  PASCAL_FILE_MODE_WRITE     = 1;
  PASCAL_FILE_MODE_READWRITE = 2;
  PASCAL_FILE_MODE_DEFAULT   = PASCAL_FILE_MODE_READWRITE;

Constructor TFile.Init;
  Begin
    TObject.Init;
    m_bOpen       := FALSE;
    m_bFromHandle := FALSE;
    m_sFileName   := '';
    m_nOpenFlags  := 0;
    m_nError      := 0;
    DOS.DOSError  := 0;
  End;

Destructor  TFile.Done;
  Begin
    if((m_bOpen) And (Not m_bFromHandle)) then
      Close;
    TObject.Done;
  End;

Function  TFile.IsError : Boolean;
  Begin
    IsError := m_nError <> 0;
  End;

Function  TFile.GetError : Integer;
  Begin
    GetError := m_nError;
  End;

Function  TFile.SetError(bIOError : Boolean) : Boolean; { called after *every* Pascal IO operation }
  Begin
    if(bIOError) then
      m_nError := System.IOResult { Pascal does only return the last error *once* }
    else
      m_nError := DOS.DOSError;
    DOS.DOSError := 0;
    SetError := IsError;
  End;

Function TFile.Open(sFileName : PathStr; nOpenFlags : Word) : Boolean;
  Begin
    Open := FALSE;
    m_sFileName  := UpperCaseStr(FExpand(sFileName)); { make sure that it's a full path }

    m_nOpenFlags := nOpenFlags;
    if(((nOpenFlags And FILE_MODE_CREATE) = 0) And
       (Not FileExists(m_sFileName))) Then
      exit;

    System.Assign(m_hfile, m_sFileName);
    if(SetError(TRUE)) then
      exit;
    if( ((nOpenFlags And FILE_MODE_CREATE) <> 0) ) then
      {$I-} System.Rewrite(m_hfile) {$I+}
    else
      Begin
        if(((nOpenFlags And FILE_MODE_READ ) <> 0) And
           ((nOpenFlags And FILE_MODE_WRITE) <> 0)) then
          System.FileMode := PASCAL_FILE_MODE_READWRITE
        else
          if((nOpenFlags And FILE_MODE_READ ) <> 0) then
            System.FileMode := PASCAL_FILE_MODE_READ
          else
            System.FileMode := PASCAL_FILE_MODE_WRITE;
        System.Reset(m_hfile);
        System.FileMode := PASCAL_FILE_MODE_DEFAULT;
      End;
    if(SetError(TRUE)) then
      exit;
    m_bOpen := TRUE;
    Open := TRUE;
  End;

Function  TFile.GetName : PathStr;
  Begin
    GetName := m_sFileName;
  End;

Function  TFile.GetDrive : Char;
  Begin
    GetDrive := m_sFileName[1];
  End;

Function TFile.Close : Boolean;
  Begin
    Close := FALSE;
    if(m_bOpen) then
      Begin
        System.Close(m_hfile);
        Close := Not SetError(TRUE);
      End;
    m_bOpen := FALSE;
  End;

Function TFile.Read (pDest : Pointer; nByteCount : Word) : Word;

  Var
    result : Word;

  Begin
    System.BlockRead(File(m_hfile), pDest^, nByteCount * SizeOf(Byte), result);
    Read := result;
  End;

Function TFile.Write(pSrc : Pointer; nByteCount : Word) : Word;

  Var
    result : Word;

  Begin
    System.BlockWrite(File(m_hfile), pSrc^, nByteCount * SizeOf(Byte), result);
    Write := result;
  End;

Function TFile.Remove : Boolean;
  Begin
    Remove := FALSE;
    if(m_bOpen) then
      if(Not Close) then
        exit;
    System.Erase(m_hfile);
    Remove := Not SetError(TRUE);
  End;

Function  TFile.Rename(sNewName : PathStr) : Boolean;
  Begin
    Rename := FALSE;
    if(Not Close) then
      exit;
    m_sFileName  := UpperCaseStr(FExpand(sNewName)); { make sure that it's a full path }
    System.Rename(m_hfile, m_sFileName);
    Rename := Not SetError(TRUE);
  End;

Function TFile.Seek(nByteCount : LongInt; nOffset : Integer) : Boolean;

  Var
    p : LongInt;

  Begin
    case(nOffset) of
      FILE_SEEK_END : p := GetSize - nByteCount;
      FILE_SEEK_CUR : p := GetPos  + nByteCount;
      FILE_SEEK_SET : p := 0       + nByteCount;
      else
        p := 0;
    End;
    System.Seek(m_hFile, p);
    Seek := Not SetError(TRUE);
  End;

Function TFile.GetSize : LongInt;
  Begin
    GetSize := System.FileSize(m_hfile);
  End;

Function TFile.GetPos : LongInt;
  Begin
    GetPos := System.FilePos(m_hfile);
  End;

Function TFile.GetTime(pDest : PDateTime) : Boolean;

  Var
    t : LongInt;

  Begin
    DOS.GetFTime(m_hfile, t);
    UnpackTime(t, pDest^);
    GetTime := Not SetError(FALSE); { DOSError ? }
  End;

Function TFile.SetTime(dt : DateTime ) : Boolean;

  Var
    t : LongInt;

  Begin
    { Pascal bug - 47 sec's becomes 46 !! }
    PackTime(dt, t);
    DOS.SetFTime(m_hfile, t);
    SetTime := Not SetError(FALSE); { DOSError ? }
  End;

Function IsDrivePresent(d : char) : Boolean;
  Begin
    IsDrivePresent := -1 <> Dos.DiskFree(Ord(UpperCaseChar(d)) - Ord('A') + 1);
  End;

Function  GetDriveFree(d : char) : LongInt;

  Function GetDefaultDrive : Char;

    Var
      s : String;

    Begin
      GetDir(0, s);
      GetDefaultDrive := s[1];
    End;

  Begin
    If(d = #0) then
      d := GetDefaultDrive
      ;
    GetDriveFree := DiskFree(Ord(UpperCaseChar(d)) - Ord('A') + 1);
  End;

Procedure TTextFile.WriteStr(s : String);
  Begin
    Write(@s[1], Length(s));
  End;

Procedure TTextFile.WriteLn(s : String);
  Begin
    s := s + #13 + #10;
    WriteStr(s);
  End;

Procedure TTextFile.WriteStrZ(psz : PChar);
  Begin
    Write(psz, strlen(psz));
  End;

Procedure TTextFile.WriteLnZ (psz : PChar);

  Const
    szCrLf : sz3 = #13 + #10;

  Var
    sz : sz512;

  Begin
    strcopy(sz, psz);
    strcat(sz, szCrLf);
    WriteStrZ(sz);
  End;

Function  TTextFile.ReadLn : Str80;

  Var
    p : LongInt;
    len : Byte ;
    s2 : str2;
    s : Str80;

  Begin
    p := GetPos;
    s2 := '12';
    while((s2 <> #13 + #10) And (s2 <> #10 + #13)) do
      Begin
        if(2 <> Read(@s2[1], 2)) then
          break;
        Seek(-1, FILE_SEEK_CUR);
      End;
    s := '';
    if((s2 = #13 + #10) Or (s2 = #10 + #13)) then
      Begin
        len := GetPos - p - 1;
        Seek(p, FILE_SEEK_SET);
        s[0] := Char(len);
        Read(@s [1], len);
        Read(@s2[1], 2);
      End
    else
      Seek(p, FILE_SEEK_SET);
    ReadLn := s;
  End;

Constructor TIncFile.Init(nInc : LongInt);
  Begin
    TFile.Init;
    m_nInc := nInc;
  End;

Function  TIncFile.Open(sFileName : PathStr; nOpenFlags : Word) : Boolean;
  Begin
    Open := FALSE;
    if(Not TFile.Open(sFileName, nOpenFlags)) then
      exit;
    if(GetSize < m_nInc) then
      DoIncrement;
    Open := TRUE;
  End;

Procedure TIncFile.DoIncrement;

  Const
    BLOCKSIZE = 8192;

  Var
    p          : Pointer;
    nBlockSize : Word;
    nByteCount : LongInt;
    nOldPos : LongInt;

  Begin
    nOldPos := GetPos;
    nBlockSize := BLOCKSIZE;
    If(nBlockSize > m_nInc) then
      nBlockSize := m_nInc;
    GetMem(p, nBlockSize);    { get dummy data block }
    memset(p, 0, nBlockSize); { zero it }
    nByteCount := 0;
    Seek(0, FILE_SEEK_END);
    while(nByteCount < m_nInc - nBlockSize) do
      begin
        TFile.Write(p, nBlockSize);
        inc(nByteCount, nBlockSize);
      end;
    nByteCount := m_nInc - nByteCount;
    if(nByteCount > 0) then { write the rest }
      TFile.Write(p, nByteCount);
    FreeMem(p, nBlockSize);

    { close and re-open }
    Close;
    TFile.Open(m_sFileName, m_nOpenFlags And (Not FILE_MODE_CREATE));
    Seek(nOldPos, FILE_SEEK_SET); { return pointer }
  End;

Function  TIncFile.Write(pSrc : Pointer; nByteCount : Word) : Word;
  Begin
    Write := 0;
    if(GetPos + nByteCount > GetSize) then
      Begin
        if(GetDriveFree(GetDrive) > m_nInc) then
          DoIncrement { add dummy block at end }
        else
          exit; { no room - exit and return 0 }
      End;
    Write := TFile.Write(pSrc, nByteCount);
  End;

Function  TIncFile.GetInc : LongInt;
  Begin
    GetInc := m_nInc;
  End;

Function  CopyFile(sDest, sSrc : PathStr) : Boolean;

  Const
    BLOCKSIZE = 8192;

  Var
    fDest, fSrc : TFile;

  Procedure DoCopy;

    Var
      p           : Pointer;
      nBlockSize  : Word;
      dt          : DateTime;

    Begin
      GetMem(p, nBlockSize);    { get dummy data block }
      nBlockSize := BLOCKSIZE;
      while(nBlockSize = BLOCKSIZE) do
        begin
          nBlockSize := fSrc.Read(p, BLOCKSIZE);
          fDest.Write(p, nBlockSize);
        end;
      FreeMem(p, nBlockSize);
      fSrc .GetTime(@dt);
      fDest.SetTime(dt);
    End;

  Begin
    fSrc .Init;
    fDest.Init;
    CopyFile := FALSE;
    if (fSrc .Open(sSrc , FILE_MODE_READ) And
        fDest.Open(sDest, FILE_MODE_CREATE or FILE_MODE_READWRITE)) then
      Begin
        DoCopy;
        CopyFile := TRUE;
      End;
    fSrc .Done;
    fDest.Done;
  End;

Function  MoveFile(sDest, sSrc : PathStr) : Boolean;

  Function IsSameDrive : Boolean;

    Var
      sPath1 , sPath2 : PathStr;

    Begin
      sPath1 := DOS.FExpand(sSrc);
      sPath2 := DOS.FExpand(sDest);
      IsSameDrive := UpperCaseChar(sPath1[1]) = UpperCaseChar(sPath2[1]);
    End;

  Function JustRename : Boolean;

    Var
      f : TFile;
      dt : DateTime;

    Begin
      f.Init;
      JustRename := FALSE;
      if (f.Open(sSrc , FILE_MODE_READWRITE)) then
        Begin
          f.GetTime(@dt);
          JustRename := f.Rename(sDest); { closes f }
          if(f.Open(sDest, FILE_MODE_READWRITE)) then { re-open and set time }
            f.SetTime(dt);
        End;
      f.Done;
    End;

  Begin
    MoveFile := FALSE;
    if(IsSameDrive) then { if on same drive, simple renaming will do }
      Begin
        MoveFile := JustRename;
        exit;
      End;
    if(Not CopyFile(sDest, sSrc)) then
      exit;
    MoveFile := RemoveFile(sSrc);
  End;

Function  SetFileTime(sFileName : PathStr; dt    : DateTime ) : Boolean;

  Var
    f : TFile;

  Begin
    SetFileTime := FALSE;
    f.Init;
    if(f.Open(sFileName, FILE_MODE_WRITE)) then
      SetFileTime := f.SetTime(dt);
    f.Done;
  End;

Function  GetFileTime(sFileName : PathStr; pDest : PDateTime) : Boolean;

  Var
    f : TFile;

  Begin
    GetFileTime := FALSE;
    f.Init;
    if(f.Open(sFileName, FILE_MODE_READ)) then
      GetFileTime := f.GetTime(pDest);
    f.Done;
  End;

Function RemoveFile(sFileName : PathStr) : Boolean; { remove one or more files }

  var
    sr    : SearchRec;
    bOK   : Boolean;
    f     : TFile;
    sDir  : DirStr;
    sName : NameStr; { Not used }
    sExt  : ExtStr;  { Not used }

  Begin
    f.Init;
    DOS.FSplit(sFileName, sDir, sName, sExt);
    DOS.FindFirst(sFileName, Archive, sr);
    bOK := DosError = 0;
    while(DosError = 0) do
      begin
        if(f.Open(sDir + sr.Name, FILE_MODE_WRITE)) then
          bOK := bOK And f.Remove;
        DOS.FindNext(sr);
      end;
    f.Done;
    RemoveFile := bOK;
  End;

function FileExists(sFileName : PathStr) : Boolean;
  { Boolean function that returns True if the file exists; otherwise,
    it returns False. Closes the file if it exists. }

  Var
    f : file;

  Begin
    FileExists := FALSE;
    if(sFileName = '') then
      exit;
    {$I-}
    System.Assign(f, sFileName);
    System.FileMode := PASCAL_FILE_MODE_READ;
    System.Reset(F);
    System.Close(F);
    {$I+}
    System.FileMode := PASCAL_FILE_MODE_DEFAULT;
    FileExists := (System.IOResult = 0);
  End; { FileExists }

Function IsDriveReadOnly(d : char) : Boolean;

  Var
    f : file;

  Begin
    IsDriveReadOnly := FALSE;
    {$I-}
    System.Assign(f, d + ':\plzualzw.azq');
    System.FileMode := PASCAL_FILE_MODE_READWRITE;
    System.Rewrite(f);
    System.Close(f);
    {$I+}
    System.FileMode := PASCAL_FILE_MODE_DEFAULT;
    if(System.IOResult = 0) then { was created - not read only}
      Begin
        System.Erase(f);
        exit;
      End;
    IsDriveReadOnly := TRUE;
  End; { FileExists }

Function UpperCaseChar(c : char) : char;
  begin
    Case(c) of
      '‘' : UpperCaseChar := '’';
      '›' : UpperCaseChar := '';
      '†' : UpperCaseChar := '';
      else
        UpperCaseChar := UpCase(c);
    end;
  end;

Function UpperCaseStr(s : Str80) : Str80;

  Var
    a:integer;

  begin
    For a := 1 to Length(s) do
      s[a] := UpperCaseChar(s[a]);
    UpperCaseStr := s;
  end;

Function memset(pDest : Pointer; c : Integer; nCount : Word) : Pointer;
  Begin
    System.FillChar(pDest^, nCount, c);
    memset := pDest;
  End;

Function memmove(pDest, pSrc : Pointer; nCount : Word) : Pointer;
  Begin
    move(pSrc^, pDest^, nCount);
    memmove := pDest;
  End;

Begin
end.

This page © Troels Knakkergaard. Updated march 30rd 1999