Open file as shared (Update)

mk-soft · Post by **mk-soft** » Sun Feb 21, 2010 4:01 pm

How to find a code to open file as shared. PB ReadFile open files as explicit!

Thanks

blueznl · Post by **blueznl** » Sun Feb 21, 2010 9:06 pm

Yeah, I'd love an open parameter for opening shared as well, but it isn't there... You have to go the way of the (win)api...

mk-soft · Post by **mk-soft** » Wed Feb 24, 2010 8:08 pm

I know,

Now write a code for reading files...

RASHAD · Post by **RASHAD** » Wed Feb 24, 2010 8:50 pm

Hi mk-soft
I do not know what do you mean by opening a file as shared
If you mean that a special user or group can only open the file or a directory, so go to DOS box help and read every thing about
1- Takeown
2- icacls
and of course if you find that is your request so you can run it from windows enviroment easily

Good luck

mk-soft · Post by **mk-soft** » Wed Feb 24, 2010 10:50 pm

When PB a file have open than can´t another application saving the same file.

Here now my first code for open file as shared and read strings

Update v1.02
- Checked CR, LF, LFCR, CRLF for NewLine

Code: Select all

;-TOP
; Kommentar     :
; Author        : mk-soft
; Second Author :
; Datei         : files.pb
; Version       : 1.02
; Erstellt      : 24.02.2010
; Geändert      : 28.02.2010
;
; Compilermode  :
;
; ***************************************************************************************

EnableExplicit

Structure udtMyFile
  hFile.i
  lpReOpenBuff.OFSTRUCT
  Eof.i
EndStructure

Global NewList MyFile.udtMyFile()
Global FileLastError

; ***************************************************************************************

Procedure MyIsFile(File)

  ForEach MyFile()
    If MyFile() = File
      ProcedureReturn #True
    EndIf
  Next
  ProcedureReturn #False
EndProcedure

; ***************************************************************************************

Procedure MyOpenFile(filename.s, uStyle = #OF_READ)

  Protected hFile
  Protected lpReOpenBuff.OFSTRUCT
  Protected result
 
  hFile = OpenFile_(@filename, lpReOpenBuff, uStyle)
  If hFile = 0
    FileLastError = GetLastError_()
    ProcedureReturn 0
  Else
    result = AddElement(MyFile())
    With MyFile()
      \hFile = hFile
      \lpReOpenBuff = lpReOpenBuff
      \Eof = #False
    EndWith
    ProcedureReturn result
  EndIf
 
EndProcedure

; ***************************************************************************************

Procedure MyCloseFile(File)
 
  Protected r1
 
  If File
    ChangeCurrentElement(MyFile(), File)
    r1 = CloseHandle_(MyFile()\hFile)
    If r1 = 0
      FileLastError = GetLastError_()
    EndIf
    DeleteElement(MyFile())
  EndIf
  ProcedureReturn r1
 
EndProcedure

; ***************************************************************************************

Procedure.q MyLof(File)

  Protected result.q
  Protected dwError.i
  Protected dwSizeLow.l
  Protected dwSizeHigh.l
 
  If File = 0
    ProcedureReturn -1
  EndIf
 
  ChangeCurrentElement(MyFile(), File)
  dwSizeLow = GetFileSize_(MyFile()\hFile, @dwSizeHigh)
  If dwSizeLow = $FFFFFFFF
    dwError = GetLastError_()
    If dwError <> #NO_ERROR
      FileLastError = dwError
      ProcedureReturn -1
    EndIf 
  Else
    result = (dwSizeHigh << 32) | dwSizeLow
    ProcedureReturn result
  EndIf
 
EndProcedure

; ***************************************************************************************

Procedure MyEof(*File.udtMyFile)
  ProcedureReturn *File\Eof
EndProcedure

; ***************************************************************************************

Procedure.q MySeekFile(File, position.q)
 
  Protected result.q
  Protected dwError.i
  Protected dwPosLow.l
  Protected dwPosHigh.l
 
  If File = 0
    ProcedureReturn 0
  EndIf
 
  dwPosLow = position & $FFFFFFFF
  dwPosHigh = position >> 32
 
  ChangeCurrentElement(MyFile(), File)
  dwPosLow = SetFilePointer_(MyFile()\hFile, dwPosLow, @dwPosHigh, #FILE_BEGIN)
  If dwPosLow = $FFFFFFFF
    dwError = GetLastError_()
    If dwError <> #NO_ERROR
      FileLastError = dwError
      ProcedureReturn -1
    EndIf 
  Else
    result = (dwPosHigh << 32) | dwPosLow
    ProcedureReturn result
  EndIf
EndProcedure

; ***************************************************************************************

Procedure.s MyReadString(File)

  Protected lpBuffer.Character, nNumberOfBytesToRead, lpNumberOfByteRead
  Protected r1
  Protected result.s
  Protected LastChar.c = 0 
  
  If File = 0
    ProcedureReturn ""
  EndIf
 
  ChangeCurrentElement(MyFile(), File)
  nNumberOfBytesToRead = 1
  result = ""
  Repeat
    r1 = ReadFile_(MyFile()\hFile, @lpBuffer, nNumberOfBytesToRead, @lpNumberOfByteRead, #Null)
    If r1 = 0
      Break
    Else
      If lpNumberOfByteRead = 0
        MyFile()\Eof = #True
        Break
      EndIf
      If LastChar = #LF And lpBuffer\c = #CR
        Break
      ElseIf LastChar = #CR And lpBuffer\c = #LF 
        Break
      ElseIf LastChar = #CR Or LastChar = #LF
        SetFilePointer_(MyFile()\hFile, -1, 0, #FILE_CURRENT)
        Break
      Else
        If lpBuffer\c <> #CR And lpBuffer\c <> #LF
          result + Chr(lpBuffer\c)
        EndIf
      EndIf
      LastChar = lpBuffer\c
    EndIf
  ForEver
 
  ProcedureReturn result
 
EndProcedure

; ***************************************************************************************

GT

blueznl · Post by **blueznl** » Sun Feb 28, 2010 5:22 pm

I've gone the same route, but I would prefer it if it would be part of PureBasic.

mk-soft · Post by **mk-soft** » Sun Feb 28, 2010 5:31 pm

I hope that it soon in purebasic the option shared will give too

P.S. Update v1.02

t57042 · Post by **t57042** » Mon Oct 24, 2011 11:52 am

Do you have an example how to use the functions for 'using files shared'?

Thanks
Richard

t57042 · Post by **t57042** » Wed Oct 26, 2011 4:02 pm

After a lot of searching following code. It works with a small testfile test.txt containing 3 lines

Code: Select all

test1
test2
test3

2 questions:
1. I cannot figure out the parameter of the MyEof() function.
2. I need a MyWriteString(File) function to be able to write.

Thanks
Richard

Code: Select all

    ;-TOP
    ; Kommentar     :
    ; Author        : mk-soft
    ; Second Author :
    ; Datei         : files.pb
    ; Version       : 1.02
    ; Erstellt      : 24.02.2010
    ; Geändert      : 28.02.2010
    ;
    ; Compilermode  :
    ;
    ; ***************************************************************************************

      Structure udtMyFile
      hFile.i
      lpReOpenBuff.OFSTRUCT
      Eof.i
    EndStructure

    Global NewList MyFile.udtMyFile()
    Global FileLastError

    ; ***************************************************************************************

    Procedure MyIsFile(File)

      ForEach MyFile()
        If MyFile() = File
          ProcedureReturn #True
        EndIf
      Next
      ProcedureReturn #False
    EndProcedure

    ; ***************************************************************************************

    Procedure MyOpenFile(filename.s, uStyle =  #OF_READ)

      Protected hFile
      Protected lpReOpenBuff.OFSTRUCT
      Protected result

      hFile = OpenFile_(@filename, lpReOpenBuff, uStyle)
      If hFile = 0
        FileLastError = GetLastError_()
        ProcedureReturn 0
      Else
        result = AddElement(MyFile())
        With MyFile()
          \hFile = hFile
          \lpReOpenBuff = lpReOpenBuff
          \Eof = #False
        EndWith
        ProcedureReturn result
      EndIf

    EndProcedure

    ; ***************************************************************************************

    Procedure MyCloseFile(File)

      Protected r1

      If File
        ChangeCurrentElement(MyFile(), File)
        r1 = CloseHandle_(MyFile()\hFile)
        If r1 = 0
          FileLastError = GetLastError_()
        EndIf
        DeleteElement(MyFile())
      EndIf
      ProcedureReturn r1

    EndProcedure

    ; ***************************************************************************************

    Procedure.q MyLof(File)

      Protected result.q
      Protected dwError.i
      Protected dwSizeLow.l
      Protected dwSizeHigh.l

      If File = 0
        ProcedureReturn -1
      EndIf

      ChangeCurrentElement(MyFile(), File)
      dwSizeLow = GetFileSize_(MyFile()\hFile, @dwSizeHigh)
      If dwSizeLow = $FFFFFFFF
        dwError = GetLastError_()
        If dwError <> #NO_ERROR
          FileLastError = dwError
          ProcedureReturn -1
        EndIf
      Else
        result = (dwSizeHigh << 32) | dwSizeLow
        ProcedureReturn result
      EndIf

    EndProcedure

    ; ***************************************************************************************

    Procedure MyEof(*File.udtMyFile)
      ProcedureReturn *File\Eof
    EndProcedure

    ; ***************************************************************************************

    Procedure.q MySeekFile(File, position.q)

      Protected result.q
      Protected dwError.i
      Protected dwPosLow.l
      Protected dwPosHigh.l

      If File = 0
        ProcedureReturn 0
      EndIf

      dwPosLow = position & $FFFFFFFF
      dwPosHigh = position >> 32

      ChangeCurrentElement(MyFile(), File)
      dwPosLow = SetFilePointer_(MyFile()\hFile, dwPosLow, @dwPosHigh, #FILE_BEGIN)
      If dwPosLow = $FFFFFFFF
        dwError = GetLastError_()
        If dwError <> #NO_ERROR
          FileLastError = dwError
          ProcedureReturn -1
        EndIf
      Else
        result = (dwPosHigh << 32) | dwPosLow
        ProcedureReturn result
      EndIf
    EndProcedure

    ; ***************************************************************************************

    Procedure.s MyReadString(File)

      Protected lpBuffer.Character, nNumberOfBytesToRead, lpNumberOfByteRead
      Protected r1
      Protected result.s
      Protected LastChar.c = 0
     
      If File = 0
        ProcedureReturn ""
      EndIf

      ChangeCurrentElement(MyFile(), File)
      nNumberOfBytesToRead = 1
      result = ""
      Repeat
        r1 = ReadFile_(MyFile()\hFile, @lpBuffer, nNumberOfBytesToRead, @lpNumberOfByteRead, #Null)
        If r1 = 0
          Break
        Else
          If lpNumberOfByteRead = 0
            MyFile()\Eof = #True
            Break
          EndIf
          If LastChar = #LF And lpBuffer\c = #CR
            Break
          ElseIf LastChar = #CR And lpBuffer\c = #LF
            Break
          ElseIf LastChar = #CR Or LastChar = #LF
            SetFilePointer_(MyFile()\hFile, -1, 0, #FILE_CURRENT)
            Break
          Else
            If lpBuffer\c <> #CR And lpBuffer\c <> #LF
              result + Chr(lpBuffer\c)
            EndIf
          EndIf
          LastChar = lpBuffer\c
        EndIf
      ForEver

      ProcedureReturn result

    EndProcedure

    ; ***************************************************************************************
    ; main
    a=MyOpenFile("test.txt", uStyle = #OF_SHARE_COMPAT)
    s$=MyReadString(a)
    Debug Str(a) + "  " + s$
    Debug MyLof(a)
    MySeekFile(a, 7)
    s$=MyReadString(a)
    Debug "second:  " +  s$    
    MyCloseFile(a)
    End

t57042 · Post by **t57042** » Fri Oct 28, 2011 3:04 pm

With my (very) limited knowledge of API I tried to write a MyWriteString myself.
It is supposed to need 3 parameters: the filehandle, the string and the length of the string to write.
As expected it does not work.
What is wrong with it?

This is the API function (from ALLAPI)

Code: Select all

Declare Function WriteFile Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long

Code: Select all

    ;-TOP
    ; Kommentar     :
    ; Author        : mk-soft
    ; Second Author :
    ; Datei         : files.pb
    ; Version       : 1.02
    ; Erstellt      : 24.02.2010
    ; Geändert      : 28.02.2010
    ;
    ; Compilermode  :
    ;
    ; ***************************************************************************************

    ;EnableExplicit

    Structure udtMyFile
      hFile.i
      lpReOpenBuff.OFSTRUCT
      Eof.i
    EndStructure

    Global NewList MyFile.udtMyFile()
    Global FileLastError

    ; ***************************************************************************************

    Procedure MyIsFile(File)

      ForEach MyFile()
        If MyFile() = File
          ProcedureReturn #True
        EndIf
      Next
      ProcedureReturn #False
    EndProcedure

    ; ***************************************************************************************

    Procedure MyOpenFile(filename.s, uStyle =  #OF_READ)

      Protected hFile
      Protected lpReOpenBuff.OFSTRUCT
      Protected result

      hFile = OpenFile_(@filename, lpReOpenBuff, uStyle)
      If hFile = 0
        FileLastError = GetLastError_()
        ProcedureReturn 0
      Else
        Global h = hFile
        result =  AddElement(MyFile())
        
        With MyFile()
          \hFile = hFile
          \lpReOpenBuff = lpReOpenBuff
          \Eof = #False
        EndWith
        ProcedureReturn result
        
      EndIf

    EndProcedure

    ; ***************************************************************************************

    Procedure MyCloseFile(File)

      Protected r1

      If File
        ChangeCurrentElement(MyFile(), File)
        r1 = CloseHandle_(MyFile()\hFile)
        If r1 = 0
          FileLastError = GetLastError_()
        EndIf
        DeleteElement(MyFile())
      EndIf
      ProcedureReturn r1

    EndProcedure

    ; ***************************************************************************************

    Procedure.q MyLof(File)

      Protected result.q
      Protected dwError.i
      Protected dwSizeLow.l
      Protected dwSizeHigh.l

      If File = 0
        ProcedureReturn -1
      EndIf

      ChangeCurrentElement(MyFile(), File)
      dwSizeLow = GetFileSize_(MyFile()\hFile, @dwSizeHigh)
      If dwSizeLow = $FFFFFFFF
        dwError = GetLastError_()
        If dwError <> #NO_ERROR
          FileLastError = dwError
          ProcedureReturn -1
        EndIf
      Else
        result = (dwSizeHigh << 32) | dwSizeLow
        ProcedureReturn result
      EndIf

    EndProcedure

    ; ***************************************************************************************

    Procedure MyEof(*File.udtMyFile)
      ProcedureReturn *File\Eof
    EndProcedure

    ; ***************************************************************************************

    Procedure.q MySeekFile(File, position.q)

      Protected result.q
      Protected dwError.i
      Protected dwPosLow.l
      Protected dwPosHigh.l

      If File = 0
        ProcedureReturn 0
      EndIf

      dwPosLow = position & $FFFFFFFF
      dwPosHigh = position >> 32

      ChangeCurrentElement(MyFile(), File)
      dwPosLow = SetFilePointer_(MyFile()\hFile, dwPosLow, @dwPosHigh, #FILE_BEGIN)
      If dwPosLow = $FFFFFFFF
        dwError = GetLastError_()
        If dwError <> #NO_ERROR
          FileLastError = dwError
          ProcedureReturn -1
        EndIf
      Else
        result = (dwPosHigh << 32) | dwPosLow
        ProcedureReturn result
      EndIf
    EndProcedure

    ; ***************************************************************************************

    Procedure.s MyReadString(File)

      Protected lpBuffer.Character, nNumberOfBytesToRead, lpNumberOfByteRead
      Protected r1
      Protected result.s
      Protected LastChar.c = 0
     
      If File = 0
        ProcedureReturn ""
      EndIf

      ChangeCurrentElement(MyFile(), File)
      nNumberOfBytesToRead = 1
      result = ""
      Repeat
        r1 = ReadFile_(MyFile()\hFile, @lpBuffer, nNumberOfBytesToRead, @lpNumberOfByteRead, #Null)
        If r1 = 0
          Break
        Else
          If lpNumberOfByteRead = 0
            MyFile()\Eof = #True
            Break
          EndIf
          If LastChar = #LF And lpBuffer\c = #CR
            Break
          ElseIf LastChar = #CR And lpBuffer\c = #LF
            Break
          ElseIf LastChar = #CR Or LastChar = #LF
            SetFilePointer_(MyFile()\hFile, -1, 0, #FILE_CURRENT)
            Break
          Else
            If lpBuffer\c <> #CR And lpBuffer\c <> #LF
              result + Chr(lpBuffer\c)
            EndIf
          EndIf
          LastChar = lpBuffer\c
        EndIf
      ForEver

      ProcedureReturn result

    EndProcedure

    ; ***************************************************************************************
     Procedure MyWriteString(File,text$, length)

      Protected lpBuffer.s, nNumberOfBytesToWrite
            
      lpBuffer=text$ 
      nNumberOfBytesToWrite=length
      
      ChangeCurrentElement(MyFile(), File)
      result = WriteFile_(MyFile()\hFile, @lpBuffer, nNumberOfBytesToWrite,  #Null, #Null)
      
    EndProcedure

    ; ***************************************************************************************
    
    ; main
    
      a=MyOpenFile("test.txt", uStyle = #OF_SHARE_COMPAT)
    For i= 0 To 2
      MySeekFile(a, i*7)
      s$=MyReadString(a)
      Debug s$  
    Next
    MyCloseFile(a)
    
    
   a=MyOpenFile("test.txt", uStyle = #OF_SHARE_COMPAT) 
   t$="XXXXX"
   q= MyWriteString(a,t$,3)
   MyCloseFile(a)
   
   End

mk-soft · Post by **mk-soft** » Sun Oct 30, 2011 1:06 pm

hi,
at time i can't testet. I show when i'm coming home. but i think is not linefeed and missing truncate file.

gt
Michael

t57042 · Post by **t57042** » Thu Nov 03, 2011 1:40 pm

Hallo Michael,
I think I found (a) solution:
This is probably not complete but it works.

1. last 2 arguments of the WriteFile function cannot be NULL both.
2. the file has to be opened with #OF_READWRITE parameter or #OF_WRITE parameter

Richard

Code: Select all

; ***************************************************************************************
     Procedure MyWriteString(File,text$, length)

      Protected lpBuffer.s, nNumberOfBytesToWrite,nNumberOfBytesWritten
            
      lpBuffer=text$ 
      nNumberOfBytesToWrite=length
      
      ChangeCurrentElement(MyFile(), File)
      result = WriteFile_(MyFile()\hFile, @lpBuffer, nNumberOfBytesToWrite,@nNumberOfBytesWritten, #Null)
     ; Debug result
    EndProcedure

    ; ***************************************************************************************
     ; main
        
    a=MyOpenFile("test.txt", uStyle = #OF_SHARE_COMPAT |#OF_READWRITE) 
    MySeekFile(a,0)
   t$="12345"
   q= MyWriteString(a,t$,5)
   MyCloseFile(a)
   End

t57042 · Post by **t57042** » Thu Nov 03, 2011 2:04 pm

I found already one big flaw: the function is about 30 times SLOWER then the native PB writestring function.
I presume this has something to do with buffering??

Richard

mk-soft · Post by **mk-soft** » Tue Nov 08, 2011 4:38 pm

Show here to use PB-Functions

http://www.purebasic.fr/english/viewtop ... 12&t=48116

t57042 · Post by **t57042** » Tue Nov 08, 2011 9:14 pm

Do you have an example how to use this function?
Richard

PureBasic Forums - English

Open file as shared (Update)

Open file as shared (Update)

Re: Open file as shared

Re: Open file as shared

Re: Open file as shared

Re: Open file as shared (UpDate)

Re: Open file as shared

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)

Re: Open file as shared (Update)