|
For those that tried to help, thank you.
If this was a SQLServer database, I could have used Profiler, unfortunately, this is an Ingres II database (legacy, text only environment).
So, since I could see the data for process was generating (the DLL was storing data in SQLServer), I talked to the people working on the legacy system and showed them the data.
From there, I slowly rebuilt the query to produce identical results.
The new query is stored in a table in SQLServer; the DLL will call a stored procedure that returns an SQL statement. If the source data changes, SQL changes are then made in SQL, not in the code itself.
Thanks,
Tim
|
|
|
|
|
Dear All,
I have set a timer for my windows service using Threading.Timer. I set the interval to 10000 that is 10s before finished its current job. The problem is the oCallback is called every 10000, can someone help me so that the oCallback will not fires before finish it current job.
Dim oCallback As New TimerCallback(AddressOf OnTimedEvent)
oTimer = New System.Threading.Timer(oCallback, Nothing, 0, 10000)
Private Sub OnTimedEvent(ByVal state As Object)
'need to stop timer..
EventLog1.WriteEntry("Called")
System.threading.thread.sleep(20000)' just to delay for 20 sec
'start timer back
End Sub
Thank you in advance.
awek
Programmer
Subang Jaya,Selangor, Malaysia
|
|
|
|
|
Hi Can you tell how much time it is taking to process the current job?Is it taking more than 10 sec?
You can declare a boolean variable with value flase.S et it's value to true after completing the current job and check the value of boolean variable if it is true then only move forwad otherwise return from the time function...
|
|
|
|
|
Just a thought, but why not stop the timer in your OnTimedEvent handler?? You've got the thing setup with a callback and an interval, so all you need to do at the end of the job is start the timer. At the beginning of the job, stop it.
|
|
|
|
|
Thanks for your tips. Will try to implement it.
awek
Programmer
Subang Jaya,Selangor, Malaysia
|
|
|
|
|
hi, this is kinda simple in vb6 but in vb.net its a different story. I'm trying to get the
value of the select item in my dropdown list box and try to display the selected item in a label or textbox but I can't find a way to do it. Can anyone help me with this problem?
Here is the sample code I've made to do the thing.
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim DbOraConnection As New DBConnection
drpHOList.DataSource = DbOraConnection.stnOraConnect
drpHOList.DataValueField = ("PURCEN_NAME")
drpHOList.DataBind()
End Sub
Protected Sub drpHOList_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles drpHOList.SelectedIndexChanged
'lblname.Text = drpHOList.SelectedValue
If Not Page.IsPostBack Then
lblname.Text = drpHOList.SelectedItem.Value
End If
End Sub
Hope that you can help me.
Thank you in advance. 
|
|
|
|
|
For drop down list (combobox) you can use drpHOList.text
|
|
|
|
|
Hi, the code you gave works. but, only when the form 1st load and when you try to choose another item from the list box. The text in the label wont change its text to value of the item that I choose in the list box.
|
|
|
|
|
HI...
I think you had put that code in form load only... You have to put the same code in
SelectedIndexChanged
event of Dropdownlist also.
In dpListCombo_SelectedIndexChanged
LBlSelectName.text = dpListCombo.text
|
|
|
|
|
Hi all,
i want use Timer control,for Label.
that when the user click the button the label should be appear for 5sec and disappear the label.
this should be base on Button Click only.
Please help me..
thanks in Advance.
JohnDas
|
|
|
|
|
on button click event enable the timer and set it interval properties. Also set it tick event accordingly
for example if you set interval properties to 1000 then set a global variable like
dim i as integer
and on tick event of timer
private sub timer1_tick()
if i=5 then
label1.visible=false
timer1.enabled=false
else
i=i +5
endif
end sub
hope this helps
|
|
|
|
|
Thanks very much, its working fine.
JohnDas
|
|
|
|
|
i would like to make a sha512 but i don't want to use the ones provided by visual studio. can some help
J.Hardy
|
|
|
|
|
So what do you want to use?? Google for "SHA512 library" and see what you come up with.
|
|
|
|
|
Option Explicit
'****************************************************************************************
'API CONSTANTS
'****************************************************************************************
Private Enum EditTypes
WM_CUT = &H300
WM_COPY = &H301
WM_PASTE = &H302
WM_CLEAR = &H303
WM_UNDO = &H304
End Enum
Const EM_CANUNDO = &HC6
Const EM_GETMODIFY = &HB8
'****************************************************************************************
'API FUNCTIONS
'****************************************************************************************
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
'****************************************************************************************
'CONSTANTS - PRIVATE
'****************************************************************************************
'filter for dialog
Private Const mFILEMASK = "Text Files (*.txt)|*.txt|" & _
"Encrypted Text Files (*.etf)|*.etf|" & _
"All Files (*.*)|*.*"
'Initial caption for form
Private Const mCAPTION = "Text Encryption Utility"
'edit menu item constants
Const mUNDO = 0
Const mCUT = 2
Const mCOPY = 3
Const mPASTE = 4
Const mDELETE = 5
'toolbar item constants
Const mUNDOTOOL = 7
Const mCUTTOOL = 8
Const mCOPYTOOL = 9
Const mPASTETOOL = 10
Const mDELETETOOL = 11
'encoder increment value - needs to be same for encryption and decryption
Const mENCODE = 3
'****************************************************************************************
'VARIABLES - PRIVATE
'****************************************************************************************
'flag to track status of control key - True means control key is pressed
Private mbControlKey As Boolean
'flag to track changes in open document
Private mbIsDirty As Boolean
Private msFileTitle As String
'****************************************************************************************
'EVENTS - PRIVATE
'****************************************************************************************
Private Sub Form_Activate()
ToggleEditMenu
mbIsDirty = False
End Sub
Private Sub Form_Load()
Call NewDocument
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
CheckModified
Set frmMain = Nothing
End
End Sub
Private Sub Form_Resize()
With rtbScript
.Top = tbrCommands.Height
.Left = Me.ScaleLeft
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight - sbrStatus.Height - tbrCommands.Height
End With
End Sub
Private Sub mnuEdit_Click(Index As Integer)
Select Case Index
Case mUNDO
PerformEdit WM_UNDO
Case mCUT
PerformEdit WM_CUT
Case mCOPY
PerformEdit WM_COPY
Case mPASTE
PerformEdit WM_PASTE
Case mDELETE
PerformEdit WM_CLEAR
End Select
End Sub
Private Sub mnuEditTop_Click()
Call ToggleEditMenu
End Sub
Private Sub mnuExample_Click()
Dim sMsg As String
Dim iRet As Integer
Dim sTitle As String
sTitle = "Text Encryption Example"
sMsg = "This Utility was Designed and Developed by Jim Kahl" & _
" as a way to save Visual Basic Routines as encoded script files." & _
vbCrLf & vbCrLf & "Do you want to see this message" & _
" as it would appear in an encrypted file?"
iRet = MsgBox(sMsg, vbInformation + vbYesNo, sTitle)
If iRet = vbYes Then
sMsg = Encrypt(sMsg)
sTitle = Encrypt(sTitle)
MsgBox sMsg, vbInformation, sTitle
End If
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuFile_Click(Index As Integer)
Select Case Index
Case 0
Call NewDocument
Case 1
Call OpenDocument
Case 2
Call SaveDocument
Case Else
End Select
End Sub
Private Sub mnuFind_Click(Index As Integer)
With frmFind
If Index = 1 Then
.cmdReplace.Value = True
.cmdReplace.Enabled = True
.cmdReplaceAll.Visible = True
.cmdReplaceAll.Enabled = True
.lblReplace.Visible = True
.cboReplace.Visible = True
End If
.Show
End With
End Sub
Private Sub mnuSelect_Click()
If TypeOf Me.ActiveControl Is TextBox Or _
TypeOf Me.ActiveControl Is RichTextBox Then
Me.ActiveControl.SelStart = 0
Me.ActiveControl.SelLength = Len(Me.ActiveControl.Text)
End If
ToggleEditMenu
End Sub
Private Sub rtbScript_Change()
ToggleEditMenu
mbIsDirty = True
End Sub
Private Sub rtbScript_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyControl Then
mbControlKey = True
End If
End Sub
Private Sub rtbScript_KeyPress(KeyAscii As Integer)
Debug.Print rtbScript.SelStart
If KeyAscii = 9 Then
KeyAscii = 0
SendKeys Space(4)
End If
End Sub
Private Sub rtbScript_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyControl Then
mbControlKey = False
End If
End Sub
Private Sub rtbScript_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ToggleEditMenu
End Sub
Private Sub tbrCommands_ButtonClick(ByVal Button As ComctlLib.Button)
'this section is done this way so it is more or less
'self documenting
Select Case Button.Tag
Case "New"
Call NewDocument
Case "Open"
Call OpenDocument
Case "Save"
Call SaveDocument
Case "Print"
Call PrintDocument
Case "Undo"
PerformEdit WM_UNDO
Case "Cut"
PerformEdit WM_CUT
Case "Copy"
PerformEdit WM_COPY
Case "Paste"
PerformEdit WM_PASTE
Case "Delete"
PerformEdit WM_CLEAR
Case "Find"
frmFind.Show
Case Else
End Select
End Sub
'****************************************************************************************
'METHODS - PRIVATE------------------------------THIS_____________________________________
'****************************************************************************************
Private Function Encrypt(ByRef TestScript As String) As String
Dim nLen As Long
Dim lCur As Long
Dim lCodes As Long
Dim sInput As String
Dim sOut As String
Dim sFirst As String
Dim lEncode As Long
sbrStatus.Panels("pnlMessage").Text = "Encoding Text... Please Wait"
'NOTE: this encryption routine encodes everything including spaces, tabs,
'carriage returns, etc. so it in effect saves the text exactly as formatted
'and does not actually reduce the size of the resulting file: a 7KB Text file
'will be a 7KB encoded text file
nLen = Len(TestScript)
sInput = TestScript
Do Until lCur = nLen
lCur = lCur + 1
'increment encoder value
lEncode = lEncode + mENCODE
If lEncode >= &HFF Then lEncode = 1
'get the next character in our script
sFirst = Mid(sInput, lCur, 1)
'get ascii character value and encode
lCodes = Asc(sFirst)
lCodes = lCodes Xor lEncode
'add encoded character to out string
sOut = sOut & Chr(lCodes)
Loop
Encrypt = sOut
sbrStatus.Panels("pnlMessage").Text = "Encoding Complete!"
End Function
Private Function Decrypt(ByRef TestScript As String) As String
Dim nLen As Long
Dim lCur As Long
Dim lCodes As Long
Dim sInput As String
Dim sOut As String
Dim sFirst As String
Dim lEncode As Long
nLen = Len(TestScript)
sInput = TestScript
sbrStatus.Panels("pnlMessage").Text = "Decoding File... Please Wait"
'NOTE: this simply decodes the encoded text preserving all characters, including
'spaces, tabs, carriage returns so the text looks exactly as it did before it
'went through the encryption process
Do Until lCur = nLen
lCur = lCur + 1
'increment encoder value
lEncode = lEncode + mENCODE
If lEncode >= &HFF Then lEncode = 1
'retrieve a character from the script
sFirst = Mid(sInput, lCur, 1)
'get ascii character value and decode
lCodes = Asc(sFirst)
lCodes = lCodes Xor lEncode
'add decoded character to our string
sOut = sOut & Chr(lCodes)
Loop
'make sure we do not display the end of file marker
Decrypt = Left(sOut, Len(sOut) - 2)
sbrStatus.Panels("pnlMessage").Text = "Decoding Complete!"
End Function
Private Sub NewDocument()
CheckModified
'set caption to default and empty the textbox
Me.Caption = mCAPTION
rtbScript.Text = vbNullString
mbIsDirty = False
End Sub
Private Sub OpenDocument()
On Error GoTo OpenDocumentErr
Dim f As Integer
Dim sFile As String
Dim sLine As String
'has present text been modified?
CheckModified
Screen.MousePointer = vbHourglass
Me.Caption = mCAPTION
'setup and return common dialog values
With cdlFiles
.Filter = mFILEMASK
.FilterIndex = 2
.InitDir = "c:\temp"
.CancelError = True
.ShowOpen
sbrStatus.Panels("pnlMessage").Text = "Opening File... Please Wait!"
rtbScript.Text = vbNullString
Me.Refresh
f = FreeFile
'need to open encrypted files as binary
If InStr(1, LCase(.FileName), ".etf") Then
Open .FileName For Binary As #f
sFile = Input(32000, #f)
rtbScript.Text = Decrypt(sFile)
Close #f
'anything else we treat as simple text
Else
Open .FileName For Input As #f
Do Until EOF(f)
Line Input #f, sLine
sFile = sFile & vbCrLf & sLine
Loop
rtbScript.Text = sFile
Close #f
End If
'set form caption to display filename
msFileTitle = .FileTitle
Me.Caption = Me.Caption & " - " & msFileTitle
End With
mbIsDirty = False
OpenDocumentExit:
'cleanup and exit
Screen.MousePointer = vbDefault
sbrStatus.Panels("pnlMessage").Text = vbNullString
Exit Sub
OpenDocumentErr:
If Err.Number <> 32755 Then
'user did not cancel so display error message
Dim sMsg As String
Dim sTitle As String
Dim lRet As Long
sMsg = Err.Number & ": " & Err.Description
sTitle = "Error Opening File"
lRet = MsgBox(sMsg, vbCritical + vbRetryCancel, sTitle)
If lRet = vbRetry Then
'try to open the document again
Call OpenDocument
End If
End If
GoTo OpenDocumentExit
End Sub
Private Sub SaveDocument()
On Error GoTo SaveDocumentErr
Dim f As Integer
Dim sFile As String
Dim iCnt As Integer
Dim sSearch As String
Dim sReplace As String
Const NIL = "0"
Const ONE = "1"
Const TWO = "2"
Const TRE = "3"
Screen.MousePointer = vbHourglass
'first replace constants with their literal equivalents
sbrStatus.Panels("pnlMessage").Text = "Replacing Enumerated Constants with Literal Values"
'replace all constants with their literal equivalents
'NOTE: This section taken out for Company confidentiality
'Example:
'Replace "TEST", "5"
sbrStatus.Panels("pnlMessage").Text = vbNullString
mbIsDirty = True
'setup and return common dialog
With cdlFiles
.Filter = mFILEMASK
.FilterIndex = 2
.InitDir = "c:\temp"
.CancelError = True
.ShowSave
sbrStatus.Panels("pnlMessage").Text = "Saving File... Please Wait"
Me.Refresh
f = FreeFile
'encrypt script file
If InStr(1, .FileName, ".etf") Then
sFile = Encrypt(rtbScript.Text)
'save as simple text file
Else
sFile = rtbScript.Text
End If
Open .FileName For Output As #f
Print #f, sFile
Close #f
mbIsDirty = False
'change caption to reflect filename
msFileTitle = .FileTitle
Me.Caption = mCAPTION & " - " & msFileTitle
End With
SaveDocumentExit:
'return the mouse pointer to default before exiting
Screen.MousePointer = vbDefault
sbrStatus.Panels("pnlMessage").Text = vbNullString
Exit Sub
SaveDocumentErr:
If Err.Number <> 32755 Then
'user did not cancel so display error message
Dim sMsg As String
Dim sTitle As String
Dim lRet As Long
sMsg = Err.Number & ": " & Err.Description
sTitle = "Error Saving File"
lRet = MsgBox(sMsg, vbCritical + vbRetryCancel, sTitle)
If lRet = vbRetry Then
Call SaveDocument
End If
End If
GoTo SaveDocumentExit
End Sub
Private Sub PrintDocument()
'not sure why but any line greater than the page width gets clipped and doesn't wrap
'to the next line when it's printed
sbrStatus.Panels("pnlMessage").Text = "Printing Document"
CheckModified
'set up the printer object and send contents of text box to it
With Printer
With .Font
.Name = "Courier New"
.Size = 10
End With
.Orientation = vbPRORPortrait
.PaperSize = vbPRPSLetter
Printer.Print rtbScript.Text
.EndDoc
End With
sbrStatus.Panels("pnlMessage").Text = vbNullString
End Sub
Private Sub Replace(ByVal Find As String, ByVal Replace As String)
'this is a scaled down version of the routine in frmFind since
'we are performing a replace all for our enumerated constants
Dim lszFile As Long
Dim iFile1 As Integer
Dim iFile2 As Integer
Dim lszFind As Long
Dim lszReplace As Long
Dim sLine As String
Dim lStart As Long
Dim lRet As Long
Dim sLine1 As String
Dim sLine2 As String
Dim sNewLine As String
Const OLDFILE = "c:\oldtemp.txt"
Const NEWFILE = "c:\newtemp.txt"
Find = Trim(Find)
Replace = Trim(Replace)
On Error GoTo ErrHandler
'create temporary file of current contents
frmMain.rtbScript.SaveFile OLDFILE
'return the file length of temp file
lszFile = FileLen(OLDFILE)
'open both temp files
iFile1 = FreeFile
Open OLDFILE For Input As #iFile1
iFile2 = FreeFile
Open NEWFILE For Output As #iFile2
'get the length of the find and replace strings
lszFind = Len(Find)
lszReplace = Len(Replace)
Do Until EOF(iFile1)
'read in the first line to get going
Line Input #iFile1, sNewLine
lStart = 1
Do Until lStart >= Len(sNewLine)
lRet = InStr(lStart, sNewLine, Find, vbTextCompare)
If lRet = 0 Then
Exit Do
Else
'selection found so replace it and set position to start
'searching again
sLine1 = Left(sNewLine, lRet - 1)
sLine2 = Mid(sNewLine, (lRet + lszFind))
sNewLine = sLine1 & Replace & sLine2
lStart = lRet + lszReplace
End If
Loop
'print the updated line to the new temp file
Print #iFile2, sNewLine
Loop
Close
'load the contents of the new temp file into the test box
rtbScript.LoadFile NEWFILE
'delete the temp files
Kill OLDFILE
Kill NEWFILE
Exit Sub
ErrHandler:
Debug.Print Err.Number & ": " & Err.Description
End Sub
Private Sub PerformEdit(ByRef EditType As EditTypes)
If TypeOf Me.ActiveControl Is TextBox Then
Call SendMessage(Me.ActiveControl.hWnd, EditType, 0, 0&)
ElseIf TypeOf Me.ActiveControl Is RichTextBox Then
If mbControlKey = False Then
Call SendMessage(Me.ActiveControl.hWnd, EditType, 0, 0&)
End If
Else
End If
End Sub
Private Sub ToggleEditMenu()
On Error Resume Next
If TypeOf Me.ActiveControl Is TextBox Or _
TypeOf Me.ActiveControl Is RichTextBox Then
'Determine if last edit can be undone
Me.mnuEdit(mUNDO).Enabled = SendMessage(Me.ActiveControl.hWnd, EM_CANUNDO, 0, 0&)
'See if there's anything to cut, copy, or delete
Me.mnuEdit(mCUT).Enabled = Me.ActiveControl.SelLength
Me.mnuEdit(mCOPY).Enabled = Me.ActiveControl.SelLength
Me.mnuEdit(mDELETE).Enabled = Me.ActiveControl.SelLength
'See if there's anything to paste
Me.mnuEdit(mPASTE) = Clipboard.GetFormat(vbCFText)
'enable disable toolbar buttons based on menu items
Me.tbrCommands.Buttons(mUNDOTOOL).Enabled = Me.mnuEdit(mUNDO).Enabled
Me.tbrCommands.Buttons(mCUTTOOL).Enabled = Me.mnuEdit(mCUT).Enabled
Me.tbrCommands.Buttons(mCOPYTOOL).Enabled = Me.mnuEdit(mCOPY).Enabled
Me.tbrCommands.Buttons(mDELETETOOL).Enabled = Me.mnuEdit(mDELETE).Enabled
Me.tbrCommands.Buttons(mPASTETOOL).Enabled = Me.mnuEdit(mPASTE).Enabled
Else
'If active control is not a textbox then disable all
Me.mnuEdit(mUNDO).Enabled = False
Me.mnuEdit(mCUT).Enabled = False
Me.mnuEdit(mCOPY).Enabled = False
Me.mnuEdit(mPASTE).Enabled = False
Me.mnuEdit(mDELETE).Enabled = False
Me.tbrCommands.Buttons(mUNDOTOOL).Enabled = False
Me.tbrCommands.Buttons(mCUTTOOL).Enabled = False
Me.tbrCommands.Buttons(mCOPYTOOL).Enabled = False
Me.tbrCommands.Buttons(mDELETETOOL).Enabled = False
Me.tbrCommands.Buttons(mPASTETOOL).Enabled = False
End If
End Sub
Private Sub CheckModified()
Dim lRet As Integer
'See if user has changed the text, and if so prompt before loading new copy.
If mbIsDirty Then
If SendMessage(rtbScript.hWnd, EM_GETMODIFY, 0, 0&) Then
lRet = MsgBox("Text has been modified do you wish to save it?", _
vbYesNo + vbQuestion, "Warning")
End If
End If
If lRet = vbYes Then SaveDocument
End Sub
J.Hardy
|
|
|
|
|
No idea. I have better things to do than read screens full of someone else's code. Try it and see?
Bob
Ashfield Consultants Ltd
|
|
|
|
|
First of all, it's VB6 code, not VB.NET and most of which has nothing to do with SHA512 at all. Next, if this is your level of knowledge, you'd be MUCH better off usingthe built in library and not trying to do this yourself.
|
|
|
|
|
That isn't SHA512. Its not even SHA. Its not even a hash. It barely even counts as encryption.
Its an extremely weak obfuscation using a key of "3". Its about as secure as ROT13.
This is why you ALWAYS use the built in functions. You SHOULD NOT try to make your own implementation, because at best you are wasting your time, and more likely you will screw something up. You should NEVER, EVER, EVER try to design your own encryption algorithm, because when people try to do this they end up with something which is trivially vulnerable because they don't understand the maths behind it.
Use the built in API.
|
|
|
|
|
moonshaddow wrote: sha512 but i don't want to use the ones provided by visual studio
Why not?
Until people understand what your objection to the built in version is they are unlikely to help you. The reason is that the built in SHA512 encryption is already optimised and stable. This is something you are unlikely to have the time to do.
|
|
|
|
|
There's no reason not to use those.
|
|
|
|
|
oh well, don't worry, i am going to learn about sha512 and i'm thinking of trying to adapt the one in wiki, but thanks anyway
J.Hardy
|
|
|
|
|
|
First, you'll do the exact same thing any of us is going to do. Go to Google and search for "Multilayer Feedforward neural network". The rest is up to you. Demanding code is considered very rude since all it takes is a little effort on your part to find, and maybe more effort to convert the code from another language. What makes this even worse is the "Urgent!!!Urgent!!!" thing. Any urgency on your part makes absolutely no difference to anyone here, or on any other forum. You're not paying for support, so you don't get to dictate to anyone when they answer your question.
|
|
|
|
|
Hi All!
I have spent months preparing everything I need to develop an integrated development environment. Just to demystify the subject for me. However I'm having trouble with compilers  .
My problem is not with acquiring a free compiler, but with finding a decent one that i can distribute/integrate with my application without either making the whole package freely destributable (GPL) or having to pay fees.
Does anybody know of any good free compilers that are in the public domain?
I'm working in VB so I am posting in the VB forum, sorry if there's a more suitable one that i didn't know of!
Thanks!
MrWolfy 
|
|
|
|
|
|
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
