I use Excel VBA to call IrfanView in the command line mode. Some settings can be passed in the argument, and others have to be changed in the ini file. And a few, like Save as Progressive JPG, default to off and cannot be turned on at all. Please fix this Irfan.
To make changes in the ini file, I wrote of bunch of functions, which I'd like to share here. (There were indents.)
Option Explicit
' Excel 2002 doesn't recognize %APPDATA%, so user must be hardcoded here
Public Const PathToIrfanIni = "C:\Users\donwi\AppData\Roaming\IrfanView\i_vi ew64 .ini"
Private Sub ChangeIrfanSettings(WantedSettings As String)
' can change multiple, deliminate with ";"
' settings are found in %APPDATA%\IrfanView\i_view64.ini (open Notepad, Ctrl-O, and paste that in with Ctrl-V)
' arg examples: "SaveOption=0;SaveQuality=75" and
Dim j As Integer
Dim ini As String, Oldini As String, OldSetting As String, setting As String, tail As String
Dim val As String, WantedSetting As String
ini = ReadInUnicode(PathToIrfanIni, True)
Oldini = ini
WantedSettings = WantedSettings & ";"
LoopTop:
' pick off this loop's setting
j = InStr(WantedSettings, ";")
WantedSetting = Left(WantedSettings, j - 1)
WantedSettings = DropStr(WantedSettings, j)
' we test, and skip if wanted setting is already set
If 0 = InStr(ini, WantedSetting) Then
j = InStr(WantedSetting, "=")
setting = Left(WantedSetting, j - 1)
val = DropStr(WantedSetting, j)
j = InStr(ini, setting)
' after = sign
tail = DropStr(ini, j + Len(setting))
' remove old value
tail = DropStr(tail, InStr(tail, vbCr) - 1)
' rebuild
ini = Left(ini, j - 1) & setting & "=" & val & tail
End If
If Len(WantedSettings) > 0 Then GoTo LoopTop:
If Oldini <> ini Then SaveFile PathToIrfanIni, ini
End Sub
Function ReadInUnicode(FileName As String, Optional RemIrfanMsg As Boolean) As String
Dim NewStr As String
Dim i As Long
Dim res As Variant
res = ReadByteArrFromFile(FileName)
If (res(0) = 255 And res(1) = 254) Or (res(0) = 254 And res(1) = 255) Then
For i = 2 To UBound(res)
If res(i) <> 0 Then
NewStr = NewStr & Chr(res(i))
End If
Next i
' for IrfanView we need to remove from beginning
If RemIrfanMsg Then
NewStr = DropStr(NewStr, InStr(NewStr, "[Lan") - 1)
End If
Else
For i = 0 To UBound(res)
NewStr = NewStr & Chr(res(i))
Next i
End If
ReadInUnicode = NewStr
End Function
Function ReadByteArrFromFile(FilePath) As Byte()
' needed to read in Unicode, which isn't character text
' From: https://www.codestack.net/visual-bas...d-binary-file/
Dim buff() As Byte
Dim fileNum As Integer
fileNum = FreeFile
Open FilePath For Binary Access Read As fileNum
ReDim buff(0 To LOF(fileNum) - 1)
Get fileNum, , buff
Close fileNum
ReadByteArrFromFile = buff
End Function
Sub SaveFile(ByVal PathName As String, D As Variant)
If FileExists(PathName) Then Kill PathName
Open PathName For Output As Home
' VBA likes to add a CRLF at the end. So we remove ours.
' -> be careful. be sure you have one to remove
If Len(D) > 2 Then
D = DropStr(D, -2)
End If
Print #1, D
Close Home
End Sub
Function DropStr(ByVal S As String, ByVal n As Long) As String
' if n is negative drops from end
If n = 0 Then
DropStr = S
ElseIf n < 0 Then
DropStr = Left(S, Len(S) + n)
Else
DropStr = Right(S, Len(S) - n)
End If
End Function
Function FileExists(ByVal FilePath As String) As Boolean
' Checks if a file or path exists (using the Dir function). does not distinguish between them
On Error Resume Next
If Len(FilePath) > 0 Then
If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
End If
On Error GoTo 0
End Function
To make changes in the ini file, I wrote of bunch of functions, which I'd like to share here. (There were indents.)
Option Explicit
' Excel 2002 doesn't recognize %APPDATA%, so user must be hardcoded here
Public Const PathToIrfanIni = "C:\Users\donwi\AppData\Roaming\IrfanView\i_vi ew64 .ini"
Private Sub ChangeIrfanSettings(WantedSettings As String)
' can change multiple, deliminate with ";"
' settings are found in %APPDATA%\IrfanView\i_view64.ini (open Notepad, Ctrl-O, and paste that in with Ctrl-V)
' arg examples: "SaveOption=0;SaveQuality=75" and
Dim j As Integer
Dim ini As String, Oldini As String, OldSetting As String, setting As String, tail As String
Dim val As String, WantedSetting As String
ini = ReadInUnicode(PathToIrfanIni, True)
Oldini = ini
WantedSettings = WantedSettings & ";"
LoopTop:
' pick off this loop's setting
j = InStr(WantedSettings, ";")
WantedSetting = Left(WantedSettings, j - 1)
WantedSettings = DropStr(WantedSettings, j)
' we test, and skip if wanted setting is already set
If 0 = InStr(ini, WantedSetting) Then
j = InStr(WantedSetting, "=")
setting = Left(WantedSetting, j - 1)
val = DropStr(WantedSetting, j)
j = InStr(ini, setting)
' after = sign
tail = DropStr(ini, j + Len(setting))
' remove old value
tail = DropStr(tail, InStr(tail, vbCr) - 1)
' rebuild
ini = Left(ini, j - 1) & setting & "=" & val & tail
End If
If Len(WantedSettings) > 0 Then GoTo LoopTop:
If Oldini <> ini Then SaveFile PathToIrfanIni, ini
End Sub
Function ReadInUnicode(FileName As String, Optional RemIrfanMsg As Boolean) As String
Dim NewStr As String
Dim i As Long
Dim res As Variant
res = ReadByteArrFromFile(FileName)
If (res(0) = 255 And res(1) = 254) Or (res(0) = 254 And res(1) = 255) Then
For i = 2 To UBound(res)
If res(i) <> 0 Then
NewStr = NewStr & Chr(res(i))
End If
Next i
' for IrfanView we need to remove from beginning
If RemIrfanMsg Then
NewStr = DropStr(NewStr, InStr(NewStr, "[Lan") - 1)
End If
Else
For i = 0 To UBound(res)
NewStr = NewStr & Chr(res(i))
Next i
End If
ReadInUnicode = NewStr
End Function
Function ReadByteArrFromFile(FilePath) As Byte()
' needed to read in Unicode, which isn't character text
' From: https://www.codestack.net/visual-bas...d-binary-file/
Dim buff() As Byte
Dim fileNum As Integer
fileNum = FreeFile
Open FilePath For Binary Access Read As fileNum
ReDim buff(0 To LOF(fileNum) - 1)
Get fileNum, , buff
Close fileNum
ReadByteArrFromFile = buff
End Function
Sub SaveFile(ByVal PathName As String, D As Variant)
If FileExists(PathName) Then Kill PathName
Open PathName For Output As Home
' VBA likes to add a CRLF at the end. So we remove ours.
' -> be careful. be sure you have one to remove
If Len(D) > 2 Then
D = DropStr(D, -2)
End If
Print #1, D
Close Home
End Sub
Function DropStr(ByVal S As String, ByVal n As Long) As String
' if n is negative drops from end
If n = 0 Then
DropStr = S
ElseIf n < 0 Then
DropStr = Left(S, Len(S) + n)
Else
DropStr = Right(S, Len(S) - n)
End If
End Function
Function FileExists(ByVal FilePath As String) As Boolean
' Checks if a file or path exists (using the Dir function). does not distinguish between them
On Error Resume Next
If Len(FilePath) > 0 Then
If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
End If
On Error GoTo 0
End Function
Comment