PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Open file as shared (Update)

https://www.purebasic.fr/english/viewtopic.php?t=41197

Page 1 of 2

Open file as shared (Update)

Posted: Sun Feb 21, 2010 4:01 pm
by mk-soft
How to find a code to open file as shared. PB ReadFile open files as explicit!

Thanks

Re: Open file as shared

Posted: Sun Feb 21, 2010 9:06 pm
by blueznl
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...

Re: Open file as shared

Posted: Wed Feb 24, 2010 8:08 pm
by mk-soft
I know,

Now write a code for reading files... :(

Re: Open file as shared

Posted: Wed Feb 24, 2010 8:50 pm
by RASHAD
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

Re: Open file as shared (UpDate)

Posted: Wed Feb 24, 2010 10:50 pm
by mk-soft
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 8)

Re: Open file as shared

Posted: Sun Feb 28, 2010 5:22 pm
by blueznl
I've gone the same route, but I would prefer it if it would be part of PureBasic.

Re: Open file as shared (Update)

Posted: Sun Feb 28, 2010 5:31 pm
by mk-soft
I hope that it soon in purebasic the option shared will give too

P.S. Update v1.02

Re: Open file as shared (Update)

Posted: Mon Oct 24, 2011 11:52 am
by t57042
Do you have an example how to use the functions for 'using files shared'?

Thanks
Richard

Re: Open file as shared (Update)

Posted: Wed Oct 26, 2011 4:02 pm
by t57042
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

Re: Open file as shared (Update)

Posted: Fri Oct 28, 2011 3:04 pm
by t57042
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

Re: Open file as shared (Update)

Posted: Sun Oct 30, 2011 1:06 pm
by mk-soft
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

Re: Open file as shared (Update)

Posted: Thu Nov 03, 2011 1:40 pm
by t57042
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

Re: Open file as shared (Update)

Posted: Thu Nov 03, 2011 2:04 pm
by t57042
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

Re: Open file as shared (Update)

Posted: Tue Nov 08, 2011 4:38 pm
by mk-soft
Show here to use PB-Functions

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

Re: Open file as shared (Update)

Posted: Tue Nov 08, 2011 9:14 pm
by t57042
Do you have an example how to use this function?
Richard
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited