-
Oct 27th, 2019, 04:44 AM
#1
Thread Starter
Fanatic Member
Http Uploading files to server
Somehow I have changed correct to code for the worse ... again ... after it worked perfectly.
These are my present routines:
On the client side:
Code:
'upload file
FileOffset = 1
If FileSizeBytes > 3500000 Then BufferSize = 3500000 Else BufferSize = FileSizeBytes
FNr = FreeFile(0)
Open LocalFileAndPathName For Binary As FNr
Do While BufferSize > 0
ReDim ByteArray(0 To BufferSize - 1)
Get FNr, FileOffset, ByteArray
'Stop
Set Rs = RPC.DoRPC("UploadFileContent", ServerFilename, ByteArray, BufferSize, FileSizeBytes)
'If IsNumeric(Rs(0)) Then SaveFileOnServer = False: Exit Function
If Rs(0) < BufferSize Then SaveFileOnServer = False: Exit Function
If Rs(0) = FileSizeBytes Then SaveFileOnServer = True: Exit Function
AlreadyDownLoaded = AlreadyDownLoaded + BufferSize
FileOffset = AlreadyDownLoaded + 1
BytesLeft = FileSizeBytes - AlreadyDownLoaded
If BytesLeft <= 0 Then Exit Do
If BytesLeft < 3500000 Then BufferSize = BytesLeft Else BufferSize = 3500000
If FileOffset >= FileSizeBytes Then Exit Do
If BytesLeft <= 0 Then Exit Do
Loop
Close
And on the server side:
Code:
'does the folder exist?
FolderAndFileName = Replace(App.Path & "\" & RsIn(1), "\", "/")
LastBackSlash = InStrRev(FolderAndFileName, "/")
FolderName = Left(FolderAndFileName, LastBackSlash - 1)
FolderExists = fso.FolderExists(FolderName)
If FolderExists = False Then GoSub FolderExistNot 'make this folder and all the folders in between as well
ByteArray = RsIn(2)
BufferSize = RsIn(3)
ReDim ByteArray(0 To BufferSize - 1)
OriginalSizeBytes = RsIn(4)
'does the file or part of it already exist
If fso.FileExists(FolderAndFileName) Then
Set File = fso.GetFile(FolderAndFileName)
PresentSizeBytes = File.Size
If PresentSizeBytes < OriginalSizeBytes Then
FNr = FreeFile(0)
Open FolderAndFileName For Binary As FNr
Put FNr, PresentSizeBytes + 1, ByteArray
Close FNr
Else
UploadedByteSize = File.Size
Set RsOut = CreateResultRs("UploadFileContent", UploadedByteSize): Exit Sub
End If
Else
FNr = FreeFile(0)
Open FolderAndFileName For Binary As FNr
Put FNr, 1, ByteArray
Close FNr
End If
Set File = fso.GetFile(FolderAndFileName)
UploadedByteSize = File.Size
Set RsOut = CreateResultRs("UploadFileContent", UploadedByteSize): Exit Sub
Although these routines work fine with no errors and the 3.5MB limit is being handled, the file uploaded is corrupted for any file size uploaded.
On the server explorer it gives the correct uploaded file size for the file, but I must have made an error somewhere which I cannot find.
-
Oct 27th, 2019, 07:53 AM
#2
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Last edited by Peekay; Oct 27th, 2019 at 12:06 PM.
-
Oct 27th, 2019, 03:23 PM
#3
Re: Http Uploading files to server
I already gave a hint, to throw out these old VB-FileOps -
and to change them to modern (Unicode-capable) ones (as e.g. implemented in the RC5-FSO-Object).
Also - all these "Monster-Routines" (longer than 20 lines) have to go.
(they are Error-prone, due to their size alone).
For a "chunkbased Upload- or also Download" you should not have much more Code than in this Test-Forms UploadRoutineSimulation()-Sub:
Code:
Option Explicit
Private Sub Form_Load()
Const ClientFile As String = "C:\temp\ClientFile.txt"
Const ServerFile As String = "C:\temp\ServerFile.txt"
On Error GoTo 1
WriteTextContent ClientFile, "ABC" 'Test-File-Len = 3
If FileExists(ServerFile) Then DeleteFile ServerFile
UploadRoutineSimulation ClientFile, ServerFile, 2 '<- Test-Chunksize = 2
1 If Err Then
MsgBox "Something went wrong: " & Err.Description
ElseIf FileLen(ClientFile) <> FileLen(ServerFile) Then
MsgBox "Something went wrong (the FileLen differs)"
ElseIf GetFileHash(ClientFile) <> GetFileHash(ServerFile) Then
MsgBox "Something went wrong (the SHA1Hash differs)"
End If
End Sub
Sub UploadRoutineSimulation(ClientFile$, ServerFile$, Optional ByVal ChunkSize& = 2 ^ 19)
Dim B() As Byte, Offs As Currency, BytesRead As Long
Do
B = "": Offs = Offs + BytesRead 'reset B to zero-length bytecontent...
ReadChunk ClientFile, B, Offs, ChunkSize '...before trying to read a new chunk into B
BytesRead = UBound(B) + 1 '<- better to determine this directly from the returned B-Container
AppendChunk ServerFile, B '<- because B is what's passed to the serverside next
Loop While BytesRead
End Sub
The above code is using a handful of very short Helper-Routines (all sitting in a *.bas-File, named modFileOps):
Code:
Option Explicit
Function FileExists(FileName As String) As Boolean
FileExists = New_c.FSO.FileExists(FileName)
End Function
Function GetFileLen(FileName As String) As Currency
GetFileLen = New_c.FSO.FileLen(FileName)
End Function
Function GetFileHash(FileName As String) As String
GetFileHash = New_c.FSO.GetFileHash(FileName, CALG_SHA1)
End Function
Sub WriteTextContent(FileName As String, Text As String)
New_c.FSO.WriteTextContent FileName, Text, True
End Sub
Sub DeleteFile(FileName As String)
New_c.FSO.DeleteFile FileName
End Sub
Sub ReadChunk(FileName As String, B() As Byte, Offset, ChunkSize)
Dim S As cStream
Set S = New_c.FSO.OpenFileStream(FileName, STRM_READ Or STRM_SHARE_DENY_NONE)
S.SetPosition Offset
S.ReadToByteArr B, ChunkSize
End Sub
Sub AppendChunk(FileName As String, B() As Byte)
Dim S As cStream
Set S = New_c.FSO.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
S.SetPosition 0, STRM_SeekFromEnd
S.WriteFromByteArr B
End Sub
The Form-TestCode further above will work already (by using this new modFileOps.bas-module).
Try to uderstand and get familiar with it "as it is" - in an isolated Form-Test-Project first.
Then, to integrate it into your Remote-scenario -
this Helper-Bas-Module will have to be included on both ends (your Client- and the Server-side VB-Projects).
After that Helper-Bas-Module exists in both Projects, you will have to:
-> 1) add an additional clientside Module, named modFileOpsRPC.bas (adding similarly named Wrapper-Routines there)
-> 2) add appropriate Sub-Routines (also similarly named) into your serverside cHandler.cls
Now - the only thing remaining is, to implement (in both new Modules: modFileOpsRPC.bas and cHandler.cls) -
appropriate wrapper-routines.
Example for the FileExists-Routine, which is contained (on both ends, via modFileOps.bas)
At the clientside, the similarly named RPC-Wrapper-routine (in modFileOpsRPC.bas) would look this way:
Code:
Function FileExists(FileName As String) As Boolean
Dim RsResult As ADODB.Recordset: Set RsResult = RPC.DoRPC("FileExists", FileName)
If NoErrorIn(RsResult) Then FileExists = RsResult(0)
End Function
And at the serverside, the cHandler.cls would get the appropriate addition:
Code:
Sub FileExists()
Dim FileName As String: FileName = RsIn(1).Value
Set RsOut = CreateResultRs("Result", modFileOps.FileExists(FileName))
End Sub
As said, writing such "wrapping-pairs" will have to be repeated for any of the Routines in modFileOps.bas
(shouldn't be that hard to do - just double-check for potential copy&paste mistakes in the names and Params,
which might happen when you use the clipboard to "replicate similar wrapper-routines").
HTH
Olaf
Last edited by Schmidt; Oct 27th, 2019 at 03:29 PM.
-
Oct 27th, 2019, 08:26 PM
#4
Re: Http Uploading files to server
Originally Posted by Peekay
Somehow I have changed correct to code for the worse ... again ... after it worked perfectly.
The solution to this is to restore your code from a point in time prior to you making this change. The fact that you are posting this issue here leads me to believe you don't have backups of your code. If that is the case, that is something that you need to rectify immediately. Even if it is to just make a copy of your main projects every day to a date specific folder on a thumb drive, that is better than nothing.
-
Oct 28th, 2019, 06:42 AM
#5
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Olaf,
Thanks for this code, which is all I need, but was unaware of. It will take me some time for me to assimilate and implement.
OptionBase1,
I have at least one external and one internal backup being done constantly, but I was unaware that OneDrive, which I use, kept older versions of about 2 months or more. I had thought that they only keep the last synced version.
PK
-
Oct 29th, 2019, 01:03 AM
#6
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Olaf,
FileExists = New_c.FSO.FileExists(FileName)
I am not sure what this New_c refers to.
Does this refer to a program/project reference, an API, a class or to the Scripting dictionary?
I have read some on the CryptoAPI, but that is still Greek to me. I have no knowledge of encryption.
Thanks
PK
-
Oct 29th, 2019, 02:16 AM
#7
Re: Http Uploading files to server
Originally Posted by Peekay
I am not sure what this New_c refers to.
Does this refer to a program/project reference, ...
Yes, it is related to the (still missing) Project-Reference of vbRichClient5(.dll).
New_c is a constructor-Object, which is then "automatically there" as soon as this project-reference was ensured.
You will need to install (register via regsvr32) the RichClient5-BaseDlls on your Clients,
as well as on your Server-machine, before trying to set this reference in your client- and server-projects.
The downloads for that are on vbRichClient.com.
Olaf
-
Oct 29th, 2019, 01:02 PM
#8
Re: Http Uploading files to server
I have a program here that has the option to transfer files. I use the native VB file binary i/o and it works perfectly fine, No need for FSO or any third party tool or utility.
I really have no idea what FSO may do in such a case as I never use it in VB. I have used it in the past in EVB as that was the only option but in VB the native file i/o and related functions have always worked well for me.
-
Oct 29th, 2019, 11:23 PM
#9
Thread Starter
Fanatic Member
Re: Http Uploading files to server
DataMiser,
May I have a look at your code?
PK
-
Oct 30th, 2019, 02:51 PM
#10
Re: Http Uploading files to server
Originally Posted by Peekay
DataMiser,
May I have a look at your code?
PK
Sorry, the code I refer to is part of a commercial product and can't be posted, the server is written in VB6 and the client is written in VB.Net.
-
Oct 31st, 2019, 01:09 AM
#11
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Olaf,
I find it difficult to interpret the parameters of the methods of the vbRichClient and I cannot find an explanation of what they refer to other than reading their names in the routines and functions.
For instance I need to supply values for this:
Code:
Set S = New_c.fso.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
and I do not know what the latter two values refer to which I should supply, or should I just leave it as it is?
Thanks
PK
Last edited by Peekay; Oct 31st, 2019 at 07:11 AM.
-
Oct 31st, 2019, 07:25 AM
#12
Re: Http Uploading files to server
Originally Posted by Peekay
For instance I need to supply values for this:
Code:
Set S = New_c.fso.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
No, you don't need to supply values for this...
I wrote quite clearly further above already, that your "interface-functions" are all in modFileOps.bas,
which kind of "hides" the RC5-FSO-Object from your other code.
All you have to provide (regarding RPC-parameters in File-Write-Direction) -
is therefore reduced to the two parameters I've marked in blue below:
Code:
Sub AppendChunk(FileName As String, B() As Byte)
Dim S As cStream
Set S = New_c.FSO.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
S.SetPosition 0, STRM_SeekFromEnd
S.WriteFromByteArr B
End Sub
Originally Posted by Peekay
...and I do not know what the latter two values refer to which I should supply.
As said, the latter two parameters of FSO.OpenFileStream are not to be supplied by you.
But their meaning is described by their names (which intellisense should have shown you):
- FileName: obviously the FileName of the File you're about to open as a Stream
- Flags: a combination of AccessRight- and Behaviour-EnumValues which any FileOpen/Create-API offers
- OpenAlways: an optional Boolean-Param, which when left out (or at False) will make OpenFileStream throw an error, when the File does not exist
Since you're apparently unfamiliar with File-Flags - I guess it's a good thing, that I've left them out of the Routine AppendChunk -
which as said, is one of the 6 Routines in modFileOps.base, you'll have to make RPC-capable.
Here are the 6 routines (and their parameters) of modFileOps.bas again, you'll have to to write RPC-Wrapper-Functions for:
Function FileExists(FileName As String) As Boolean
Function GetFileLen(FileName As String) As Currency
Function GetFileHash(FileName As String) As String
Sub DeleteFile(FileName As String)
Sub AppendChunk(FileName As String, B() As Byte)
Sub ReadChunk(FileName As String, B() As Byte, Offset, ChunkSize)
In my first post #3, I've implemented the needed wrapper-pair for the FileExists-routine already as an example for you.
Please post your wrapper-pairs for the remaining 5 routines, before we proceed here...
(each part of a pair will have to go - as already mentioned in post #3 - into a new modFileOpsRPC.bas and into cHandler.cls later).
@DataMiser:
When you write the following: "I use the native VB file binary i/o and it works perfectly fine..."
then you're deluding yourself - and are misleading others, because that's just plain wrong
(since these old VBRuntime-Functions are fare from "perfectly fine").
VB6 old File-Functionality is:
- error-prone in the way it deals with FileHandles
- it does not support UniCode (in the FileNames, and in the Text-Write and -Read-functions)
- it is limited to Files < 2GB (the FileLen-Function, as well as the FileOffsets are limited to 2GB)
- it does not support the calculation of FileHashes
Olaf
-
Oct 31st, 2019, 07:38 AM
#13
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Olaf, For what it's worth this is what I am testing now:
On my client side I firstly have this:
Code:
Public Sub UploadRoutine(ClientFile$, ServerFile$, Optional ByVal ChunkSize& = 2 ^ 19)
Dim B() As Byte, Offs As Currency, BytesRead As Long
Do
B = "": Offs = Offs + BytesRead
modFileOps.ReadChunk ClientFile, B, Offs, ChunkSize
BytesRead = UBound(B) + 1
'AppendChunk ServerFile, B
modFileOpsRPC.AppendChunk ServerFile, B
Loop While BytesRead
Exit Sub
End Sub
It does not give me an error.
Might I ask if your chunks are allowed to be 2^19 long? I have set it to 3 500 000.
It then goes to my client routine in modFileOps which I quote here fully untested and which module I also have on the server side:
Code:
Option Explicit
Function FileExists(FileName As String) As Boolean
FileExists = New_c.fso.FileExists(FileName)
End Function
Function GetFileLen(FileName As String) As Currency
GetFileLen = New_c.fso.FileLen(FileName)
End Function
Function GetFileHash(FileName As String) As String
GetFileHash = New_c.fso.GetFileHash(FileName, CALG_SHA1)
End Function
Sub WriteTextContent(FileName As String, Text As String)
New_c.fso.WriteTextContent FileName, Text, True
End Sub
Sub DeleteFile(FileName As String)
New_c.fso.DeleteFile FileName
End Sub
Sub ReadChunk(FileName As String, B() As Byte, Offset, ChunkSize)
Dim S As cStream
Set S = New_c.fso.OpenFileStream(FileName, STRM_READ Or STRM_SHARE_DENY_NONE)
S.SetPosition Offset
S.ReadToByteArr B, ChunkSize
End Sub
Sub AppendChunk(FileName As String, B() As Byte)
Dim S As cStream
Set S = New_c.fso.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
S.SetPosition 0, STRM_SeekFromEnd
S.WriteFromByteArr B
End Sub
Sub CreateDirectory(FolderName As String)
New_c.fso.CreateDirectory FileName
End Sub
Function DirectoryHasSubDirs(FolderName As String) As Boolean
New_c.fso.DirectoryHasSubDirs FolderName
End Function
Function FolderExists(FolderName As String) As Boolean
New_c.fso.FolderExists FolderName
End Function
Sub GetDirList(FolderName As String)
New_c.fso.GetDirList FolderName
End Sub
Function GetFileNameFromFullPath(PathName As String) As String
New_c.fso.GetFileNameFromFullPath PathName
End Function
Function GetPathNameFromFullPath(PathName As String) As String
New_c.fso.GetPathNameFromFullPath PathName
End Function
Function IsFileWriteable(FileName As String) As Boolean
New_c.fso.GetPathNameFromFullPath PathName
End Function
Sub MoveFile(FileName As String)
New_c.fso.MoveFile FileName
End Sub
The ReadChunk does not give me any errors.
It then goes to the modFileOpsRPC which is like this:
Code:
Function ReadChunk(FileName As String, B() As Byte, Offset, ChunkSize)
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("ReadChunk", FileName, B, Offset, ChunkSize)
If NoErrorIn(RsResult) Then ReadChunk = RsResult(0)
End Function
It does not give me any errors
I get an error in the cHandler on the server side:
Code:
Sub AppendChunk()
Dim FileName As String, B() As Byte
FileName = RsIn(1).Value
B = RsIn(2).Value
Set RsOut = CreateResultRs("Result", modFileOps.AppendChunk(Replace(App.Path & "/" & RsIn(1), "\", "/"), B))
End Sub
It does not like the .appendchunk method which should send it to this routine on the serverside modFileOps:
Code:
Sub AppendChunk(FileName As String, B() As Byte)
Dim S As cStream
Set S = New_c.fso.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
S.SetPosition 0, STRM_SeekFromEnd
S.WriteFromByteArr B
End Sub
PK
-
Oct 31st, 2019, 08:05 AM
#14
Re: Http Uploading files to server
Originally Posted by Peekay
Olaf,
Thanks for this code, which is all I need, but was unaware of. It will take me some time for me to assimilate and implement.
OptionBase1,
I have at least one external and one internal backup being done constantly, but I was unaware that OneDrive, which I use, kept older versions of about 2 months or more. I had thought that they only keep the last synced version.
PK
So why can't you just restore your code from backup then if it was working fine before you made changes and broke it?
-
Oct 31st, 2019, 08:15 AM
#15
Re: Http Uploading files to server
Originally Posted by Peekay
Olaf, For what it's worth this is what I am testing now:
On my client side I firstly have this:
Code:
Public Sub UploadRoutine(ClientFile$, ServerFile$, Optional ByVal ChunkSize& = 2 ^ 19)
Dim B() As Byte, Offs As Currency, BytesRead As Long
Do
B = "": Offs = Offs + BytesRead
modFileOps.ReadChunk ClientFile, B, Offs, ChunkSize
BytesRead = UBound(B) + 1
'AppendChunk ServerFile, B
modFileOpsRPC.AppendChunk ServerFile, B
Loop While BytesRead
Exit Sub
End Sub
Before we dive into the chunked Upload- (or Download-) routines themselves,
could we first validate the following modules:
Please post the entire contents of your current:
1. modFileOps.bas (which should reside on the serverside and the clientside)
2. modFileOpsRPC.bas (which should reside only at the clientside)
3. cHandler.cls (at least the routines which are the serverside counterparts to the routines in modFileOpsRPC.bas)
BTW, you've still copy&paste errors in your posted modFileOps.bas (in routines CreateDirectory and IsFileWritable).
Please make sure, that no such errors are contained in the modules, when you post them.
Olaf
-
Oct 31st, 2019, 10:43 AM
#16
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Originally Posted by OptionBase1
So why can't you just restore your code from backup then if it was working fine before you made changes and broke it?
I could do that, but it seems to me that Olaf has a much more robust routine than I had. So I will gladly yield to experts - and I would yield to your advice as well. That is why I am here and that is why I engaged with you as well. I appreciate any piece of advice, as I work alone and not in a programming group, community or environment.
PK
-
Oct 31st, 2019, 10:56 AM
#17
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Olaf,
I am almost too scared to publish, but here it is .. and no doubt it contains errors:
This is my modFileOps which I have included on the client and the server side:
Code:
Option Explicit
Function FileExists(FileName As String) As Boolean
On Error GoTo ErrorHandler
FileExists = New_c.fso.FileExists(FileName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function GetFileLen(FileName As String) As Currency
On Error GoTo ErrorHandler
GetFileLen = New_c.fso.FileLen(FileName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
GetFileLen = 0
Exit Function
End Function
Function GetFileHash(FileName As String) As String
On Error GoTo ErrorHandler
GetFileHash = New_c.fso.GetFileHash(FileName, CALG_SHA1): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
GetFileHash = Error
Exit Function
End Function
Function WriteTextContent(FileName As String, Text As String) As Boolean
On Error GoTo ErrorHandler
New_c.fso.WriteTextContent FileName, Text, True: WriteTextContent = True: Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function DeleteFile(FileName As String) As Boolean
On Error GoTo ErrorHandler
New_c.fso.DeleteFile FileName: DeleteFile = True: Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function ReadChunk(FileName As String, B() As Byte, Offset, ChunkSize) As Byte()
Dim S As cStream
On Error GoTo ErrorHandler
Set S = New_c.fso.OpenFileStream(FileName, STRM_READ Or STRM_SHARE_DENY_NONE)
S.SetPosition Offset
S.ReadToByteArr B, ChunkSize
ReadChunk = B: Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function AppendChunk(FileName As String, B() As Byte) As Boolean
Dim S As cStream
On Error GoTo ErrorHandler
Set S = New_c.fso.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
S.SetPosition 0, STRM_SeekFromEnd
S.WriteFromByteArr B
AppendChunk = True: Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function CreateDirectory(FolderName As String) As Boolean
On Error GoTo ErrorHandler
New_c.fso.CreateDirectory FolderName: CreateDirectory = True: Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function DirectoryHasSubDirs(FolderName As String) As Boolean
On Error GoTo ErrorHandler
DirectoryHasSubDirs = New_c.fso.DirectoryHasSubDirs(FolderName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function FolderExists(FolderName As String) As Boolean
On Error GoTo ErrorHandler
FolderExists = New_c.fso.FolderExists(FolderName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function GetDirList(FolderName As String) As ADODB.Recordset
Rs As ADODB.Recordset
On Error GoTo ErrorHandler
Set GetDirList = New_c.fso.GetDirList(FolderName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Set GetDirList = Error
Exit Function
End Function
Function GetFileNameFromFullPath(PathName As String) As String
On Error GoTo ErrorHandler
GetFileNameFromFullPath = New_c.fso.GetFileNameFromFullPath(PathName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
GetFileNameFromFullPath = Error
Exit Function
End Function
Function GetPathNameFromFullPath(PathName As String) As String
On Error GoTo ErrorHandler
GetPathNameFromFullPath = New_c.fso.GetPathNameFromFullPath(PathName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
GetPathNameFromFullPath = Error
Exit Function
End Function
Function IsFileWriteable(FileName As String) As Boolean
On Error GoTo ErrorHandler
IsFileWriteable = New_c.fso.IsFileWritable(FileName): Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Function MoveFile(OldFileName As String, NewFileName As String) As Boolean
On Error GoTo ErrorHandler
New_c.fso.MoveFile OldFileName, NewFileName: MoveFile = True: Exit Function
On Error GoTo 0
Exit Function
ErrorHandler:
Exit Function
End Function
Here is my modFileOpsRPC only used on the client side:
Code:
Option Explicit
Function FileExists(FileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("FileExists", FileName)
If NoErrorIn(RsResult) Then FileExists = RsResult(0)
End Function
Function GetFileLen(FileName As String) As Currency
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetFileLen", FileName)
If NoErrorIn(RsResult) Then GetFileLen = RsResult(0)
End Function
Function GetFileHash(FileName As String) As String
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetFileHash", FileName)
If NoErrorIn(RsResult) Then GetFileHash = RsResult(0)
End Function
Function WriteTextContent(FileName As String, Text As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("WriteTextContent", FileName, Text)
If NoErrorIn(RsResult) Then WriteTextContent = RsResult(0)
End Function
Function DeleteFile(FileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("DeleteFile", FileName)
If NoErrorIn(RsResult) Then DeleteFile = RsResult(0)
End Function
Function ReadChunk(FileName As String, B() As Byte, Offset, ChunkSize) As Long
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("ReadChunk", FileName, B(), Offset, ChunkSize)
If NoErrorIn(RsResult) Then ReadChunk = RsResult(0)
End Function
Function AppendChunk(FileName As String, B() As Byte) As Long
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("AppendChunk", FileName, B)
If NoErrorIn(RsResult) Then AppendChunk = RsResult(0)
End Function
Function CreateDirectory(FolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("CreateDirectory", FolderName)
If NoErrorIn(RsResult) Then CreateDirectory = RsResult(0)
End Function
Function FolderExists(FolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("FolderExists", FolderName)
If NoErrorIn(RsResult) Then FolderExists = RsResult(0)
End Function
Function DirectoryHasSubDirs(FolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("DirectoryHasSubDirs", FolderName)
If NoErrorIn(RsResult) Then DirectoryHasSubDirs = RsResult(0)
End Function
'I wish I had DirectoryHasSubDirsOrFiles' or 'FolderIsEmpty'
Function GetDirList(FolderName As String) As ADODB.Recordset
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetDirList", FolderName)
If NoErrorIn(RsResult) Then GetDirList = RsResult(0)
End Function
Function GetFileNameFromFullPath(FullPathName As String) As String
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetFileNameFromFullPath", FullPathName)
If NoErrorIn(RsResult) Then GetFileNameFromFullPath = RsResult(0)
End Function
Function GetPathNameFromFullPath(FullPathName As String) As String
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetPathNameFromFullPath", FullPathName)
If NoErrorIn(RsResult) Then GetPathNameFromFullPath = RsResult(0)
End Function
Function IsFileWriteable(FileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("IsFileWriteable", FileName)
If NoErrorIn(RsResult) Then IsFileWriteable = RsResult(0)
End Function
Function MoveFile(FileName As String, OldFolder As String, NewFolder As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("MoveFile", OldFolder, NewFolder)
If NoErrorIn(RsResult) Then MoveFile = RsResult(0)
End Function
Here is my cHandler class on the server side:
Code:
Sub FileExists()
Set RsOut = CreateResultRs("FileExists", modFileOps.FileExists(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub GetFileLen()
Set RsOut = CreateResultRs("GetFileLen", modFileOps.GetFileLen(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub GetFileHash()
Set RsOut = CreateResultRs("GetFileHash", modFileOps.GetFileHash(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub WriteTextContent()
Set RsOut = CreateResultRs("WriteTextContent", modFileOps.WriteTextContent(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub DeleteFile()
Set RsOut = CreateResultRs("DeleteFile", modFileOps.DeleteFile(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub DeleteFile()
Set RsOut = CreateResultRs("DeleteFile", modFileOps.DeleteFile(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub ReadChunk()
Set RsOut = CreateResultRs("ReadChunk", modFileOps.ReadChunk(Replace(App.Path & "/" & RsIn(1), "\", "/"), RsIn(2), RsIn(3), RsIn(4)))
End Sub
Sub AppendChunk()
Set RsOut = CreateResultRs("AppendChunk", modFileOps.AppendChunk(Replace(App.Path & "/" & RsIn(1), "\", "/"), RsIn(2)))
End Sub
Sub CreateDirectory()
Set RsOut = CreateResultRs("CreateDirectory", modFileOps.CreateDirectory(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub DirectoryHasSubDirs()
Set RsOut = CreateResultRs("DirectoryHasSubDirs", modFileOps.DirectoryHasSubDirs(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
'I wish I had DirectoryHasSubDirsOrFiles' or 'FolderIsEmpty'
Sub FolderExists()
Set RsOut = CreateResultRs("FolderExists", modFileOps.FolderExists(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub GetDirList()
Set RsOut = CreateResultRs("GetDirList", modFileOps.GetDirList(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub GetFileNameFromFullPath()
Set RsOut = CreateResultRs("GetFileNameFromFullPath", modFileOps.GetFileNameFromFullPath(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub GetPathNameFromFullPath()
Set RsOut = CreateResultRs("GetPathNameFromFullPath", modFileOps.GetPathNameFromFullPath(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub IsFileWriteable()
Set RsOut = CreateResultRs("IsFileWriteable", modFileOps.IsFileWriteable(Replace(App.Path & "/" & RsIn(1), "\", "/")))
End Sub
Sub MoveFile()
Set RsOut = CreateResultRs("MoveFile", modFileOps.MoveFile(Replace(App.Path & "/" & RsIn(1), "\", "/"), Replace(App.Path & "/" & RsIn(2), "\", "/")))
End Sub
PK
-
Oct 31st, 2019, 04:31 PM
#18
Re: Http Uploading files to server
Originally Posted by Peekay
I am almost too scared to publish, but here it is ...
Well, it was not that bad (aside from the real weird error-handling you've unnecessarily added to the routines in modFileOps.bas)...
Here is my revised code for the three parts (please take it over into your projects unchanged).
modFileOps.bas
Code:
Option Explicit
Function FileExists(FileName As String) As Boolean
FileExists = New_c.FSO.FileExists(FileName)
End Function
Function DeleteFile(FileName As String) As Boolean
DeleteFile = New_c.FSO.DeleteFile(FileName)
End Function
Function GetFileLen(FileName As String) As Currency
GetFileLen = New_c.FSO.FileLen(FileName)
End Function
Function GetFileHash(FileName As String) As String
GetFileHash = New_c.FSO.GetFileHash(FileName, CALG_SHA1)
End Function
Function FolderExists(FolderName As String) As Boolean
FolderExists = New_c.FSO.FolderExists(FolderName)
End Function
Function DeleteDirectory(FolderName As String) As Boolean
DeleteDirectory = New_c.FSO.RemoveDirectory(FolderName)
End Function
Function CreateDirectory(FolderName As String) As Boolean
CreateDirectory = New_c.FSO.CreateDirectory(FolderName)
End Function
Function DirectoryHasSubDirs(FolderName As String) As Boolean
DirectoryHasSubDirs = New_c.FSO.DirectoryHasSubDirs(FolderName)
End Function
'both Text-Read/Write-functions are hardwired, to read and write UTF8-content
Function ReadTextContent(FileName As String) As String
ReadTextContent = New_c.FSO.ReadTextContent(FileName, False, CP_UTF8)
End Function
Function WriteTextContent(FileName As String, Text As String) As Boolean
New_c.FSO.WriteTextContent FileName, Text, True
WriteTextContent = True
End Function
Function ReadChunk(FileName As String, ByVal Offset As Currency, ByVal ChunkSize As Long) As Byte()
Dim S As cStream
Set S = New_c.FSO.OpenFileStream(FileName, STRM_READ Or STRM_SHARE_DENY_NONE)
S.SetPosition Offset
S.ReadToByteArr ReadChunk, ChunkSize
End Function
Function AppendChunk(FileName As String, B() As Byte) As Boolean
Dim S As cStream
Set S = New_c.FSO.OpenFileStream(FileName, STRM_WRITE Or STRM_SHARE_DENY_NONE, True)
S.SetPosition 0, STRM_SeekFromEnd
S.WriteFromByteArr B
AppendChunk = True
End Function
Function GetDirList(FolderName As String) As ADODB.Recordset
Set GetDirList = New ADODB.Recordset 'instantiate the Rs directly into the return-type-functionname
GetDirList.Fields.Append "Name", vbString
GetDirList.Fields.Append "IsDirectory", vbBoolean
GetDirList.Fields.Append "FileSize_Or_HasSubDirs", vbCurrency
GetDirList.Fields.Append "LastChanged", vbDate
GetDirList.Open 'open it, after appending the above 4 Fields
With New_c.FSO.GetDirList(FolderName)
Dim i As Long, ArrFields(): ArrFields = Array(0, 1, 2, 3)
For i = 0 To .SubDirsCount - 1
GetDirList.AddNew ArrFields, Array(.SubDirName(i), True, New_c.FSO.DirectoryHasSubDirs(.Path & .SubDirName(i)), .SubDirLastWriteTime(i))
Next
For i = 0 To .FilesCount - 1
GetDirList.AddNew ArrFields, Array(.FileName(i), False, .FileSize(i), .FileLastWriteTime(i))
Next
End With
End Function
Function GetFileNameFromFullPath(PathName As String) As String
GetFileNameFromFullPath = New_c.FSO.GetFileNameFromFullPath(PathName)
End Function
Function GetPathNameFromFullPath(PathName As String) As String
GetPathNameFromFullPath = New_c.FSO.GetPathNameFromFullPath(PathName)
End Function
Function IsFileWriteable(FileName As String) As Boolean
IsFileWriteable = New_c.FSO.IsFileWritable(FileName)
End Function
Function MoveFile(OldFileName As String, NewFileName As String) As Boolean
MoveFile = New_c.FSO.MoveFile(OldFileName, NewFileName, True)
End Function
Function MakeServerPath(ByVal RelPath As String) As String
MakeServerPath = Replace(App.Path & "\" & RelPath, "/", "\")
End Function
modFileOpsRPC.bas
Code:
Option Explicit
Function FileExists(RelFileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("FileExists", RelFileName)
If NoErrorIn(RsResult) Then FileExists = RsResult(0)
End Function
Function DeleteFile(RelFileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("DeleteFile", RelFileName)
If NoErrorIn(RsResult) Then DeleteFile = RsResult(0)
End Function
Function GetFileLen(RelFileName As String) As Currency
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetFileLen", RelFileName)
If NoErrorIn(RsResult) Then GetFileLen = RsResult(0)
End Function
Function GetFileHash(RelFileName As String) As String
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetFileHash", RelFileName)
If NoErrorIn(RsResult) Then GetFileHash = RsResult(0)
End Function
Function FolderExists(RelFolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("FolderExists", RelFolderName)
If NoErrorIn(RsResult) Then FolderExists = RsResult(0)
End Function
Function DeleteDirectory(RelFolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("DeleteDirectory", RelFolderName)
If NoErrorIn(RsResult) Then DeleteDirectory = RsResult(0)
End Function
Function CreateDirectory(RelFolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("CreateDirectory", RelFolderName)
If NoErrorIn(RsResult) Then CreateDirectory = RsResult(0)
End Function
Function DirectoryHasSubDirs(RelFolderName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("DirectoryHasSubDirs", RelFolderName)
If NoErrorIn(RsResult) Then DirectoryHasSubDirs = RsResult(0)
End Function
Function ReadTextContent(RelFileName As String) As String
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("ReadTextContent", RelFileName)
If NoErrorIn(RsResult) Then ReadTextContent = RsResult(0)
End Function
Function WriteTextContent(RelFileName As String, Text As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("WriteTextContent", RelFileName, Text)
If NoErrorIn(RsResult) Then WriteTextContent = RsResult(0)
End Function
Function ReadChunk(RelFileName As String, ByVal Offset As Currency, ByVal ChunkSize As Long) As Byte()
ReadChunk = "" 'initialize the function-result to an empty ByteArray
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("ReadChunk", RelFileName, Offset, ChunkSize)
If NoErrorIn(RsResult) Then ReadChunk = RsResult(0)
End Function
Function AppendChunk(RelFileName As String, B() As Byte) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("AppendChunk", RelFileName, B)
If NoErrorIn(RsResult) Then AppendChunk = RsResult(0)
End Function
Function GetDirList(RelFolderName As String) As ADODB.Recordset
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("GetDirList", RelFolderName)
If NoErrorIn(RsResult) Then Set GetDirList = RsResult
End Function
Function IsFileWriteable(RelFileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("IsFileWriteable", RelFileName)
If NoErrorIn(RsResult) Then IsFileWriteable = RsResult(0)
End Function
Function MoveFile(RelOldFileName As String, RelNewFileName As String) As Boolean
Dim RsResult As ADODB.Recordset
Set RsResult = RPC.DoRPC("MoveFile", RelOldFileName, RelNewFileName)
If NoErrorIn(RsResult) Then MoveFile = RsResult(0)
End Function
And finally the cHandler.cls Routines
Code:
Sub FileExists()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("FileExists", modFileOps.FileExists(MakeServerPath(RsIn(1))))
End Sub
Sub DeleteFile()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("DeleteFile", modFileOps.DeleteFile(MakeServerPath(RsIn(1))))
End Sub
Sub GetFileLen()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("GetFileLen", modFileOps.GetFileLen(MakeServerPath(RsIn(1))))
End Sub
Sub GetFileHash()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("GetFileHash", modFileOps.GetFileHash(MakeServerPath(RsIn(1))))
End Sub
Sub FolderExists()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("FolderExists", modFileOps.FolderExists(MakeServerPath(RsIn(1))))
End Sub
Sub DeleteDirectory()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("DeleteDirectory", modFileOps.DeleteDirectory(MakeServerPath(RsIn(1))))
End Sub
Sub CreateDirectory()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("CreateDirectory", modFileOps.CreateDirectory(MakeServerPath(RsIn(1))))
End Sub
Sub DirectoryHasSubDirs()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("DirectoryHasSubDirs", modFileOps.DirectoryHasSubDirs(MakeServerPath(RsIn(1))))
End Sub
Sub ReadTextContent()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("ReadTextContent", modFileOps.ReadTextContent(MakeServerPath(RsIn(1))))
End Sub
Sub WriteTextContent()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("WriteTextContent", modFileOps.WriteTextContent(MakeServerPath(RsIn(1)), CStr(RsIn(2))))
End Sub
Sub ReadChunk()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("ReadChunk", modFileOps.ReadChunk(MakeServerPath(RsIn(1)), RsIn(2), RsIn(3)))
End Sub
Sub AppendChunk()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Dim B() As Byte: B = RsIn(2)
Set RsOut = CreateResultRs("AppendChunk", modFileOps.AppendChunk(MakeServerPath(RsIn(1)), B))
End Sub
Sub GetDirList()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = modFileOps.GetDirList(MakeServerPath(RsIn(1)))
End Sub
Sub IsFileWriteable()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("IsFileWriteable", modFileOps.IsFileWriteable(MakeServerPath(RsIn(1))))
End Sub
Sub MoveFile()
On Error Resume Next 'allow Errors from subroutine-calls, to bubble up into this routine
Set RsOut = CreateResultRs("MoveFile", modFileOps.MoveFile(MakeServerPath(RsIn(1)), MakeServerPath(RsIn(2))))
End Sub
As for your question regarding the ChunkSize - yes - I think 512KByte or 256KByte are entirely sufficient
(you will not loose performance compared to larger chunksizes, and it is a small enough one, that you could even implement a little Progress-Indicator,
which updates itself any "half a second" or so - after each Chunks Up- or Download).
Also note, that I've tried to make the GetDirList-Routine into something that really returns an ADO-Recordset
(in your first attempts, you should simply visualize the GetDirList-results in an MSHFlexGrid, before you try to "hang it into a TreeView-Control")
Ok, and since I'm now kinda "into it, anyways" - here some Form-TestCode, with fully implemented UploadFile and DownloadFile-routines:
Code:
Private Sub Form_Click()
Dim sErr As String
sErr = UploadFile("c:\temp\test.jpg", "some.jpg")
If Len(sErr) Then MsgBox sErr: Exit Sub
sErr = DownloadFile("some.jpg", "c:\temp\test_down.jpg")
If Len(sErr) Then MsgBox sErr: Exit Sub
End Sub
Public Function UploadFile(ClientFile$, ServerFile$, Optional ByVal ChunkSize& = 2 ^ 19)
On Error GoTo 1
Static Tmp As String, n As Currency: If n Then n = n + 1 Else n = Int(Now * 10000)
Tmp = ServerFile & "." & n 'create a temporary filename (with a unique suffix)
Dim B() As Byte, Offs As Currency, BytesRead As Long, sErr As String
Do: B = "": Offs = Offs + BytesRead
B = modFileOps.ReadChunk(ClientFile, Offs, ChunkSize)
BytesRead = UBound(B) + 1
If BytesRead > 0 Or Offs = 0 Then modFileOpsRPC.AppendChunk Tmp, B
Loop While BytesRead
1 If Err Then sErr = Err.Description Else sErr = CheckIdentity(ClientFile, Tmp)
On Error Resume Next
If Len(sErr) = 0 Then 'in case of no error so far, try to rename our temporary file to the intended FileName
If Not modFileOpsRPC.MoveFile(Tmp, ServerFile) Then sErr = "Couldn't perform final File-Renaming"
End If
If Len(sErr) Then modFileOpsRPC.DeleteFile Tmp 'in case of an error, try to cleanup the temporary serverfile
UploadFile = sErr
On Error GoTo 0
End Function
Public Function DownloadFile(ServerFile$, ClientFile$, Optional ByVal ChunkSize& = 2 ^ 19)
On Error GoTo 1
Static Tmp As String, n As Currency: If n Then n = n + 1 Else n = Int(Now * 10000)
Tmp = ClientFile & "." & n 'create a temporary filename (with a unique suffix)
Dim B() As Byte, Offs As Currency, BytesRead As Long, sErr As String
Do: B = "": Offs = Offs + BytesRead
B = modFileOpsRPC.ReadChunk(ServerFile, Offs, ChunkSize)
BytesRead = UBound(B) + 1
If BytesRead > 0 Or Offs = 0 Then modFileOps.AppendChunk Tmp, B
Loop While BytesRead
1 If Err Then sErr = Err.Description Else sErr = CheckIdentity(Tmp, ServerFile)
On Error Resume Next
If Len(sErr) = 0 Then 'in case of no error so far, try to rename our temporary file to the intended FileName
If Not modFileOps.MoveFile(Tmp, ClientFile) Then sErr = "Couldn't perform final File-Renaming"
End If
If Len(sErr) Then modFileOps.DeleteFile Tmp 'in case of an error, try to cleanup the temporary clientfile
DownloadFile = sErr
On Error GoTo 0
End Function
Public Function CheckIdentity(ClientFile$, ServerFile$) As String
On Error GoTo 1
If modFileOps.GetFileLen(ClientFile) <> modFileOpsRPC.GetFileLen(ServerFile) Then
CheckIdentity = "Err: the FileSizes are different"
ElseIf modFileOps.GetFileHash(ClientFile) <> modFileOpsRPC.GetFileHash(ServerFile) Then
CheckIdentity = "Err: the FileHashes are different"
End If
1 If Err Then CheckIdentity = Err.Description
End Function
Olaf
-
Nov 1st, 2019, 12:34 AM
#19
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Olaf,
Thank you so much, I really appreciate. This is powerful and robust stuff.
And while we are at it. Thank you for going this journey with me. It was a quantum leap for me to get into client server stuff. It was hard, but worthwhile and generally it improved my programming skills immensely.
PK
-
Nov 4th, 2019, 05:44 AM
#20
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Last edited by Peekay; Nov 4th, 2019 at 06:01 AM.
-
Jul 29th, 2020, 10:26 AM
#21
Thread Starter
Fanatic Member
Re: Http Uploading files to server
I have this code in the modFileOps module which was gratuitously given by Olaf in post 18 above:
Code:
Function ReadChunk(FileName As String, ByVal Offset As Currency, ByVal ChunkSize As Long) As Byte()
Dim S As cStream
Set S = New_c.FSO.OpenFileStream(FileName, STRM_READ Or STRM_SHARE_DENY_NONE)
S.SetPosition Offset
S.ReadToByteArr ReadChunk, ChunkSize
End Function
Although this worked quite well previously, I now get an error in code line 3. It says that: The specified module cannot be found. I am not sure what it refers to.
The filename is correct.
I presume New_C comes from the vbRichClient5 reference, but in my Project References, that reference is there and it does not indicate missing next to it. Could my Windows have changed that?
Thanks
PK
Last edited by Peekay; Jul 29th, 2020 at 09:49 PM.
-
Jul 30th, 2020, 07:31 AM
#22
Thread Starter
Fanatic Member
Re: Http Uploading files to server
Solved, thank you. The dll was misplaced in another folder.
PK
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|