devflow.kr@:~#

[C#] Resize Form with none border style

VB
  protected override void WndProc(ref Message m) {
      if (m.Msg == 0x84) {  // Trap WM_NCHITTEST
        Point pos = new Point(m.LParam.ToInt32() & 0xffff, m.LParam.ToInt32() >> 16);
        pos = this.PointToClient(pos);
        if (pos.Y < cCaption) {
          m.Result = (IntPtr)2;  // HTCAPTION
          return;
        }
        if (pos.X >= this.ClientSize.Width - cGrip && pos.Y >= this.ClientSize.Height - cGrip) {
          m.Result = (IntPtr)17; // HTBOTTOMRIGHT
          return;
        }
      }
      base.WndProc(ref m);
    }
저작자 표시 비영리 동일 조건 변경 허락
신고

[.NET]INI File Class

VB
저작자 표시 비영리 동일 조건 변경 허락
신고

느낌표 연산자 (Bang, Lookup Operator)

VB

비주얼 베이직에는 Bang이라는연산자가 있습니다...

저도 오랫만에 MSDN 포럼에 질문이 올라와있어서 생각나  포스팅해봅니다.

 

일단 이 연산자는 ADO 참조의 Recordset에서 사용의 예를 볼 수 있습니다.

 

 

 

위  코드들은  아래와 같은 역활을 합니다..

 

 

 

또한 아래와 같이 됩니다.

 

 

 

 

하지만 이러한 bang 연산자는 매우 오래된 연산자이며, 사용하는 것을 추천하지 않습니다.

 

 

 

참고 : LINQ to DataSets Rehabilitates VB's Bang Operator

저작자 표시 비영리 동일 조건 변경 허락
신고

Alpha-blend transparency form (PNG 파일 alpha로 form투명화)

VB

아래는 class입니다.

Imports System

Imports System.Drawing

Imports System.Drawing.Imaging

Imports System.Windows.Forms

Imports System.Runtime.InteropServices

'Translation from C# by Dj Den4ik

Public Class PerPixelAlphaForm

    'Implements Windows.Forms.IWin32Window


    Public Structure ARGB

        Public Blue As Byte

        Public Green As Byte

        Public Red As Byte

        Public Alpha As Byte

    End Structure


    Public Structure BLENDFUNCTION

        Public BlendOp As Byte

        Public BlendFlags As Byte

        Public SourceConstantAlpha As Byte

        Public AlphaFormat As Byte

    End Structure


    Public Const ULW_COLORKEY As Int32 = &H1

    Public Const ULW_ALPHA As Int32 = &H2

    Public Const ULW_OPAQUE As Int32 = &H4


    Public Const AC_SRC_OVER As Byte = &H0

    Public Const AC_SRC_ALPHA As Byte = &H1


    Public Declare Function UpdateLayeredWindow Lib "user32" Alias "UpdateLayeredWindow" (ByVal hwnd As IntPtr, ByVal hdcDst As IntPtr, ByRef pptDst As Point, ByRef psize As Size, ByVal hdcSrc As IntPtr, ByRef pprSrc As Point, ByVal crKey As Int32, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Int32) As Boolean

    Public Declare Function GetDC Lib "user32" Alias "GetDC" (ByVal hWnd As IntPtr) As IntPtr

    Public Declare Function ReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As IntPtr, ByVal hDC As IntPtr) As Integer

    Public Declare Function CreateCompatibleDC Lib "gdi32.dll" Alias "CreateCompatibleDC" (ByVal hDC As IntPtr) As IntPtr

    Public Declare Function DeleteDC Lib "gdi32.dll" Alias "DeleteDC" (ByVal hDC As IntPtr) As Boolean

    Public Declare Function SelectObject Lib "gdi32.dll" Alias "SelectObject" (ByVal hDC As IntPtr, ByVal hObject As IntPtr) As IntPtr

    Public Declare Function DeleteObject Lib "gdi32.dll" Alias "DeleteObject" (ByVal hObject As IntPtr) As Boolean


    Public Sub SetBitmap(ByVal bitmap As Bitmap, ByVal opacity As Byte, ByVal frm As Form)

        If bitmap.PixelFormat <> PixelFormat.Format32bppArgb Then Throw New ApplicationException("The bitmap must be 32ppp with alpha-channel.")


        ' The ideia of this is very simple,

        ' 1. Create a compatible DC with screen;

        ' 2. Select the bitmap with 32bpp with alpha-channel in the compatible DC;

        ' 3. Call the UpdateLayeredWindow.


        Dim screenDc As IntPtr = GetDC(IntPtr.Zero)

        Dim memDc As IntPtr = CreateCompatibleDC(screenDc)

        Dim hBitmap As IntPtr = IntPtr.Zero

        Dim oldBitmap As IntPtr = IntPtr.Zero


        Try

            hBitmap = bitmap.GetHbitmap(Color.FromArgb(0)) ' grab a GDI handle from this GDI+ bitmap

            oldBitmap = SelectObject(memDc, hBitmap)

            Dim size As New Size(bitmap.Width, bitmap.Height)

            Dim pointSource As New Point(0, 0)

            Dim topPos As New Point(frm.Left, frm.Top)

            Dim blend As New BLENDFUNCTION

            blend.BlendOp = AC_SRC_OVER

            blend.BlendFlags = 0

            blend.SourceConstantAlpha = opacity

            blend.AlphaFormat = AC_SRC_ALPHA

            UpdateLayeredWindow(frm.Handle, screenDc, topPos, size, memDc, pointSource, 0, blend, ULW_ALPHA)

        Finally

            ReleaseDC(IntPtr.Zero, screenDc)

            If hBitmap <> IntPtr.Zero Then

                SelectObject(memDc, oldBitmap)

                DeleteObject(hBitmap)

            End If

            DeleteDC(memDc)


        End Try

    End Sub

End Class


아래는 폼입니다.

Dim ppaf As New PerPixelAlphaForm

    Dim MainBack As Bitmap = My.Resources.mainback

    Dim bmp As New Bitmap(MainBack)

Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams

        Get

            Dim SecPerm As New Security.Permissions.SecurityPermission(Security.Permissions.PermissionState.Unrestricted)

            SecPerm.Demand()

 

            ' Extend the CreateParams property of the Button class.

            Dim cp As System.Windows.Forms.CreateParams = MyBase.CreateParams

            ' Update the button Style.

            cp.ExStyle = &H80000

 

            Return cp

        End Get

    End Property

    Public Sub redraw()

        Me.BackgroundImage = MainBack

        bmp.Dispose()

        bmp = New Bitmap(MainBack)

        For Each ctrl As Control In Me.Controls

            Application.DoEvents()

            ctrl.DrawToBitmap(bmp, ctrl.Bounds)

        Next

        Me.Region = New Region()

        ppaf.SetBitmap(bmp, 255, Me)

    End Sub

    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)

        Const WM_MOUSEMOVE As Int32 = &H200

        Const WM_NCLBUTTONDOWN As Int32 = &HA1

        Const HTCAPTION As Int32 = 2

 

        If m.Msg = WM_MOUSEMOVE Then

            MyBase.Capture = False

            Dim message As New Message

            With message

                .HWnd = Me.Handle

                .Msg = WM_NCLBUTTONDOWN

                .WParam = HTCAPTION

                .LParam = 0&

            End With

            MyBase.WndProc(message)

        End If

        MyBase.WndProc(m)

    End Sub


PNG-24를 지원합니다.

Alpha-blending으로 form을 투명화합니다.



출저 : http://pastesite.com/22086 & MORE

저작자 표시 비영리 동일 조건 변경 허락
신고

AOBSCAN Function at vb.net

VB

    Public Declare Function OpenProcess Lib "KERNEL32" _

        (ByVal DesiredAccess As Int32, _

         ByVal InheritHandle As Boolean, _

         ByVal ProcessId As Int32) _

        As Int32


    Private Declare Function ReadProcessMemory Lib "KERNEL32" _

    (ByVal Handle As Int32, _

     ByVal address As Int32, _

     ByRef Value As Int32, _

     Optional ByVal Size As Int32 = 4, _

     Optional ByVal lpNumberOfBytesWritten As Int64 = 0) _

    As Long


    Public PROCESS_VM_OPERATION As Int32 = 8

    Public PROCESS_VM_READ As Int32 = 16

    Public PROCESS_VM_WRITE As Int32 = 32


    Private process_id As Int32 = 0

    Public pHandle As Integer = 0


    Public Function GetProcessId(ByVal game_name As String) As Boolean

        Dim Processes() As Process = Process.GetProcesses

        Dim process_name As String

        Dim i As Byte

        For i = LBound(Processes) To UBound(Processes)

            process_name = Processes(i).ProcessName

            If process_name = game_name Then

                process_id = Processes(i).Id

                pHandle = OpenProcess(PROCESS_VM_OPERATION + PROCESS_VM_WRITE + PROCESS_VM_READ, False, process_id)

                Return True

            End If

        Next

        If process_id = 0 Then

            Return False

        End If

        Return False

    End Function


    Public Function ReadByte(ByVal address As Int32) As Integer

        Dim value As Integer

        ReadProcessMemory(pHandle, address, value, 1, 0)

        Return value

    End Function


    Public Function AOBSCAN(ByVal GameName As String, ByVal ModuleName As String, ByVal Signature As Byte()) As Integer

        Dim BaseAddress, EndAddress As Int32

        For Each PM As ProcessModule In Process.GetProcessesByName(GameName)(0).Modules

            If ModuleName = PM.ModuleName Then

                BaseAddress = PM.BaseAddress

                EndAddress = BaseAddress + PM.ModuleMemorySize

            End If

        Next

        Dim curAddr As Int32 = BaseAddress

        Do

            For i As Long = 0 To Signature.Length - 1

                If ReadByte(curAddr + i) = Signature(i) Then

                    If i = Signature.Length - 1 Then

                        Return curAddr

                    End If

                    Continue For

                End If

                Exit For

            Next

            curAddr += 1

        Loop While curAddr < EndAddress

        Return 0

    End Function

-----------


                Dim MyByteArray() As Byte = New Byte() {&H75, &H12}

                Dim pos As Integer = AOBSCAN("", "", MyByteArray)

                WriteMem(Proc.Handle, pos, New Byte() {&H74}, 1, 1)

저작자 표시 비영리 동일 조건 변경 허락
신고

vb.net 프로세스 리스트 가져오기

VB



.net으로 전향되면서 많은 기능들이 자체적으로 생겼습니다.

   

        Dim ProcessList As System.Diagnostics.Process()

        ProcessList = System.Diagnostics.Process.GetProcesses()

        Dim Proc As System.Diagnostics.Process


        For Each Proc In ProcessList

            If Proc.ProcessName = "notepad" Then MsgBox("Detected")

        Next



Proc의 멤버로 통해 pid, handle, path 등등 많은 정보를 얻을 수 있습니다.

저작자 표시 비영리 동일 조건 변경 허락
신고

[vb.net] Listview 정렬하기 (오름차순 내림차순)

VB

보통 listview는 자체적으로 sort를 통하여 none과 오룸, 내림순으로 정렬할 수 있다.

하지만 sort에 none이 아닌 다른설정을 주게된다면.. 사용자 임의로 리스트 재정렬(?)을 할 수 없다.

즉, 값이 바뀔때마다 계속 listview는 아이템을 sort해준다.


필요에따라 위치를 변경 할 수 있게끔 자동 sort를 대체할만한 메서드를 만들어보았다.



    Public Sub ListViewSort(ByRef lv As ListView, ByVal col As Integer, ByVal AceDec As Boolean)

        Dim lvTempItem As ListViewItem

        Dim i As Integer

        If AceDec Then

            For i = 0 To lv.Items.Count - 2 

                If CStr(lv.Items(i).SubItems(col).Text) > CStr(lv.Items(i + 1).SubItems(col).Text) Then

                    lvTempItem = lv.Items(i)

                    lv.Items(i).Remove()

                    lv.Items.Insert((i + 1), lvTempItem)

                    i = -1

                End If

            Next i

        Else

            For i = 0 To lv.Items.Count - 2 

                If CStr(lv.Items(i).SubItems(col).Text) < CStr(lv.Items(i + 1).SubItems(col).Text) Then

                    lvTempItem = lv.Items(i)

                    lv.Items(i).Remove()

                    lv.Items.Insert((i + 1), lvTempItem)

                    i = -1

                End If

            Next i

        End If

    End Sub


사용법은 아래와 같다.


 ListViewSort(byref 정렬할listview,byval 정렬을 기준할 칼럼번호,byval 1은 오름차순, 그외 내림차순)


그후 반드시 해당 리스트뷰를 refresh해주는것을 추천한다,.

저작자 표시 비영리 동일 조건 변경 허락
신고

[vb.net] Base64 Encode Decode (인코딩, 디코딩)

VB

네트워크라던지 웹프로그래밍할때 많이 사용하는 base64인코딩과 디코딩을 하는방법입니다.

방법은 닷넷에서 제공하는 Converter를 사용합니다.



* 인코딩


            Dim nByte As Byte()

            nByte = Encoding.UTF8.GetBytes(텍스트)

            Convert.ToBase64String(nByte)


* 디코딩


            Dim nByte As Byte()

            nByte = Convert.FromBase64String(텍스트)

            Encoding.UTF8.GetString(nByte)




저작자 표시 비영리 동일 조건 변경 허락
신고

[VB.NET] Upload File (파일 업로드) using HttpWebRequest

VB

Imports System.Net

Imports System.Text

Imports System.IO


Public Class HttpFileUploader


    Public Function uploadFile(ByVal containa As CookieContainer, ByVal uri As String, ByVal filePath As String, ByVal fileParameterName As String, ByVal contentType As String, ByVal otherParameters As Specialized.NameValueCollection) As String


        Dim boundary As String = "---------------------------" & DateTime.Now.Ticks.ToString("x")

        Dim newLine As String = System.Environment.NewLine

        Dim boundaryBytes As Byte() = System.Text.Encoding.ASCII.GetBytes(newLine & "--" & boundary & newLine)

        Dim request As Net.HttpWebRequest = Net.WebRequest.Create(uri)


        request.ContentType = "multipart/form-data; boundary=" & boundary

        request.Method = "POST"

        request.CookieContainer = containa

        request.AllowAutoRedirect = True

        request.Timeout = -1

        request.KeepAlive = True

        request.AllowWriteStreamBuffering = False


        Dim ms As New MemoryStream()

        Dim formDataTemplate As String = "Content-Disposition: form-data; name=""{0}""{1}{1}{2}"


        For Each key As String In otherParameters.Keys

            ms.Write(boundaryBytes, 0, boundaryBytes.Length)

            Dim formItem As String = String.Format(formDataTemplate, key, newLine, otherParameters(key))

            Dim formItemBytes As Byte() = System.Text.Encoding.UTF8.GetBytes(formItem)

            ms.Write(formItemBytes, 0, formItemBytes.Length)

        Next key


        ms.Write(boundaryBytes, 0, boundaryBytes.Length)


        Dim headerTemplate As String = "Content-Disposition: form-data; name=""{0}""; filename=""{1}""{2}Content-Type: {3}{2}{2}"

        Dim header As String = String.Format(headerTemplate, fileParameterName, filePath, newLine, contentType)

        Dim headerBytes As Byte() = System.Text.Encoding.UTF8.GetBytes(header)

        ms.Write(headerBytes, 0, headerBytes.Length)


        Dim length As Long = ms.Length

        length += New FileInfo(filePath).Length

        request.ContentLength = length


        Using requestStream As IO.Stream = request.GetRequestStream()

            Dim bheader() As Byte = ms.ToArray()

            requestStream.Write(bheader, 0, bheader.Length)

            Using fileStream As New IO.FileStream(filePath, IO.FileMode.Open, IO.FileAccess.Read)


                Dim buffer(4096) As Byte

                Dim bytesRead As Int32 = fileStream.Read(buffer, 0, buffer.Length)


                Do While (bytesRead > 0)

                    requestStream.Write(buffer, 0, bytesRead)

                    bytesRead = fileStream.Read(buffer, 0, buffer.Length)

                Loop

            End Using

            requestStream.Close()

        End Using


        Dim response As Net.WebResponse = Nothing

        Dim responseText = ""


        Try


            response = request.GetResponse()


            Using responseStream As IO.Stream = response.GetResponseStream()


                Using responseReader As New IO.StreamReader(responseStream)


                    responseText = responseReader.ReadToEnd()


                End Using


            End Using


        Catch exception As Net.WebException


            MsgBox(exception.Message)


        Finally


            response.Close()

            response = Nothing

            request = Nothing

        End Try


        Return responseText


    End Function


End Class

저작자 표시 동일 조건 변경 허락
신고

[mIRC] 마비노기 영웅전 매니저 스크립트 v1.0

VB

 



업뎃같은건 없ㅋ음ㅋ

일단 utf8.dll이 필요함.

없는 사람이 있을거같아 첨부함

mIRC.exe있는 경로에 넣으면 되염


 



원래 !거래도 지원했는데. 저번에 패치되면서 사라짐 어엉ㅇ..


* #명령어 목록
*
*  !거래 [아이템명]    -  X 마영전시펄새기들이 지원중단

*
*
*  !표시 [숫자]          -  !거래 명령어 사용시 결과할 갯수
*
*  !어디 [아이템명]    -  아이템을 획득경로를 알려줌
*
*  !아이템 [아이템명] -  아이템 옵션과 거래가능유무를
*                                표시해줌
*
*  !적막 [플톡시세] [최고강시세]
*                             - 플톡적막노기 1시간
*                                했을때  순이익을 계산
*
*  !토큰 [개수]          - 가능한 최대 출항 횟수
*
*  !제작 [아이템명]    - 제작NPC, 의뢰비용, 재료
*                                아이템, 갯수를 알려줌
*
*  !제작 [아이템명]    - 제작NPC, 의뢰비용, 재료
*                                아이템, 갯수를 알려줌
저작자 표시 동일 조건 변경 허락
신고

[vb.net] JSON을 VB.NET에서 파싱하기

VB

보통 웹프로그래밍을 하다보면 json( JavaScript Object Notation )으로 찎찎 쏴준다..

믈론 mid, split left right instr replace 노가다로 구할 수 있으나, 귀찮음과 안정성을 위해 정석인 방법을 알아보았다,

csjson을 이용하면된다.

일단 http://sourceforge.net/projects/csjson/ 에서 다운로드할 수 있다.

msi 이니깐 적당히 설치하고 프로젝트 설정에서 System.Net.Json.dll을 찾아서 참조해주면된다.

설명은 귀찮으니, 예제를 보는것으로 대체하겠다

일단 strBuf에는 텍스트로된 JSON배열이 있다.


        Dim jcResults As New System.Net.Json.JsonTextParser
        Dim jResults As System.Net.Json.JsonObjectCollection


        jResults = jcResults.Parse(strBuf)

        jUser = jResults(2)

        For Each jTok As System.Net.Json.JsonObjectCollection In jUser

            frmMnu1.lstON.Items.Add(jTok(0).GetValue, jTok(1).GetValue, 0)

        Next참 쉽죠?

그런데 왜 자바에선 eval()과 앞뒤에 (, )를 넣어주는지는 모르겠다.

물론 vb.net에선 안넣어주어도 된다,

저작자 표시 동일 조건 변경 허락
신고

[vb.net] Listview 컨트롤 사용시 주의!

VB

리스트뷰컨트롤은 매우 유용해요.
그런데 사용시 주의할것이 있습니다.

콜렉션을 초기화하는 코드,

clear 말이다. 이게 2개가 존재해요

컨트롤.clear
컨트롤.items.clear

위 바로 컨트롤을 clear하면 코드 그대로 컨트롤을 클리어해버려요

아랫건 아이템을 콜렉션을 초기화 해주네요,


참고.
저작자 표시 동일 조건 변경 허락
신고

[vb.net] form smooth controls

VB
폼에서 보통 Timer를 이용해서 위치를 연속적으로 바꾼다하면, 그래픽(하드웨어) 가속이 적용되어있지도 않고, 따로 이벤트처리가 없기때문에 컨트롤들이 심하게 발작하는걸 볼 수 있다.

그래서 따로 paint나 그런부근에 이벤트를 넣어줘야한다

timer등에서 이벤트에서 컨트롤의 위치를 설정한 후, form.Invalidate()를 해준다.
설명을 보면 알겠지만, 전체컨트롤을 다시 그려주는기능이다.

또 이벤트 Handles Me.Paint에 아래와 같이 쑤셔박아줘야한다

e.Graphics.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.AntiAlias

또한 폼 로드에 아래도 박아주자

SetStyle(ControlStyles.DoubleBuffer Or ControlStyles.AllPaintingInWmPaint Or ControlStyles.ResizeRedraw, True)

그리고 실행을 하면 많이 부드러워진 컨트롤을 볼 수 있다. 
저작자 표시 동일 조건 변경 허락
신고

URLEncode/Deocde 함수

VB
'****************************************************************************************
'*
'*  EgoCube.URLTools Component 는 공개 Component 입니다. 상업적, 비상업적인 목적으로 어디
'*  서나 자유롭게 사용하실 수 있습니다.
'*
'*  다만, 기능 추가나 에러 수정을 목적으로 Code 를 수정하셨을 때는, 제게 수정된 내용과
'*  목적에 대하여 적은 메일을 보내주셔서 제가 수정사항을 반영할 수 있도록 해주시면 감사하
'*  겠습니다. 또한, 이런식으로 수정된 Code 는 그 내용과 이유를 정리하여 제 홈페이지의
'*  내용에 추가하도록 하겠습니다. 연락처는 다음과 같습니다.
'*
'*  Homepage URL : http://www.egocube.pe.kr/
'*  E-Mail       : songgun@egocube.pe.kr
'*
'****************************************************************************************


Option Explicit
Public Type ColorsType
  rVal  As Integer
  gVal  As Integer
  bVal  As Integer
End Type
Public Type Song
    Title As String
    Artist As String
    Number As String
End Type

'****************************************************************************************
'*
'*  형 식 : Function
'*  정 의 : Public Function URLEncode(URLStr As String) As String
'*  설 명 : URLStr 인자로 입력받은 문자열을 URLEncoding 한다.
'*  작 성 : 송원석
'*  날 짜 : 2001.12.03
'*
'****************************************************************************************

Public Function URLEncode(URLStr As String) As String

    Dim sURL                As String       '** 입력받은 URL 문자열
    Dim sBuffer             As String       '** Encoding 중의 URL 을 담을 Buffer 문자열
    Dim sTemp               As String       '** 임시 문자열
    Dim cChar               As String       '** URL 문자열 중의 현재 Index 의 문자
    
    Dim Index               As Integer
    
    
    Dim lErrNum             As Long         '** Error Number
    Dim sErrSource          As String       '** Error Source
    Dim sErrDesc            As String       '** Error Description
    
    Dim sMsg                As String       '** Error Message
    
    
On Error GoTo ErrorHanddle:


    sURL = Trim(URLStr)     '** URL 문자열을 얻는다.
    sBuffer = ""            '** 임시 Buffer 용 문자열 변수 초기화.


    '******************************************************
    '* URL Encoding 작업
    '******************************************************
    
    For Index = 1 To Len(sURL)
    
        '** 현재 Index 의 문자를 얻는다.
        cChar = Mid(sURL, Index, 1)

        If cChar = "0" Or _
           (cChar >= "1" And cChar <= "9") Or _
           (cChar >= "a" And cChar <= "z") Or _
           (cChar >= "A" And cChar <= "Z") Or _
           cChar = "-" Or _
           cChar = "_" Or _
           cChar = "." Or _
           cChar = "*" Then

            '** URL 에 허용되는 문자들 :: Buffer 문자열에 추가한다.
            sBuffer = sBuffer & cChar
            
        ElseIf cChar = " " Then
        
            '** 공백 문자 :: + 로 대체하여 Buffer 문자열에 추가한다.
            sBuffer = sBuffer & "+"
            
        Else
        
            '** URL 에 허용되지 않는 문자들 :: % 로 Encoding 해서 Buffer 문자열에 추가
            sTemp = CStr(Hex(Asc(cChar)))
            
            If Len(sTemp) = 4 Then

                sBuffer = sBuffer & "%" & Left(sTemp, 2) & "%" & Mid(sTemp, 3, 2)

            ElseIf Len(sTemp) = 2 Then

                sBuffer = sBuffer & "%" & sTemp

            End If
                
        End If

    Next


    '** 결과를 리턴한다.
    URLEncode = sBuffer
    
    Exit Function
        
    
ErrorHanddle:

    '** Error 가 발생하면 공백 문자를 Return 한다.
    URLEncode = ""
    
    '** Error 정보를 얻는다.
    lErrNum = Err.Number
    sErrSource = Err.Source
    sErrDesc = Err.Description
    
    '** Event Log 에 Error 를 기록한다.
    sMsg = vbCrLf & vbCrLf & _
            "Error Object : EgoCube.URLTools," & vbCrLf & _
            "Error Method : Public Function URLEncode(URLStr As String) As String," & vbCrLf & _
            "Error Number : " & lErrNum & "," & vbCrLf & _
            "Error Source : " & sErrSource & "," & vbCrLf & _
            "Error Description : " & sErrDesc
    App.LogEvent sMsg, vbLogEventTypeError
    
    '** Error 를 발생시킨다.
    Err.Raise lErrNum, sErrSource, sErrDesc

    
    Exit Function
    
    
End Function


'****************************************************************************************
'*
'*  형 식 : Function
'*  정 의 : Public Function URLDecode(URLStr As String) As String
'*  설 명 : URLStr 인자로 입력받은 문자열을 URLDecoding 한다.
'*  작 성 : 송원석
'*  날 짜 : 2001.12.03
'*
'****************************************************************************************

Public Function URLDecode(URLStr As String) As String

    Dim sURL                As String       '** 입력받은 URL 문자열
    Dim sBuffer             As String       '** Decoding 중의 URL 을 담을 Buffer 문자열
    Dim cChar               As String       '** URL 문자열 중의 현재 Index 의 문자
    
    Dim Index               As Integer
    
    
    Dim lErrNum             As Long         '** Error Number
    Dim sErrSource          As String       '** Error Source
    Dim sErrDesc            As String       '** Error Description
    
    Dim sMsg                As String       '** Error Message


On Error GoTo ErrorHanddle:


    sURL = Trim(URLStr)     '** URL 문자열을 얻는다.
    sBuffer = ""            '** 임시 Buffer 용 문자열 변수 초기화.


    '******************************************************
    '* URL Decoding 작업
    '******************************************************
    
    Index = 1

    Do While Index <= Len(sURL)
    
        cChar = Mid(sURL, Index, 1)
        
        If cChar = "+" Then
        
            '** '+' 문자 :: ' ' 로 대체하여 Buffer 문자열에 추가한다.
            sBuffer = sBuffer & " "
            Index = Index + 1
        
        ElseIf cChar = "%" Then
        
            '** '%' 문자 :: Decoding 하여 Buffer 문자열에 추가한다.
            cChar = Mid(sURL, Index + 1, 2)
            
            If CInt("&H" & cChar) < &H80 Then
            
                '** 일반 ASCII 문자
                sBuffer = sBuffer & Chr(CInt("&H" & cChar))
                Index = Index + 3
            
            Else
            
                '** 2 Byte 한글 문자
                cChar = Replace(Mid(sURL, Index + 1, 5), "%", "")
                sBuffer = sBuffer & Chr(CInt("&H" & cChar))
                Index = Index + 6
            
            End If
        
        Else
        
            '** 그 외의 일반 문자들 :: Buffer 문자열에 추가한다.
            sBuffer = sBuffer & cChar
            Index = Index + 1
            
        End If
    
    Loop
    
    
    '** 결과를 리턴한다.
    URLDecode = sBuffer
    
    Exit Function
        
    
ErrorHanddle:

    '** Error 가 발생하면 공백 문자를 Return 한다.
    URLDecode = ""
    
    '** Error 정보를 얻는다.
    lErrNum = Err.Number
    sErrSource = Err.Source
    sErrDesc = Err.Description
    
    '** Event Log 에 Error 를 기록한다.
    sMsg = vbCrLf & vbCrLf & _
            "Error Object : EgoCube.URLTools," & vbCrLf & _
            "Error Method : Public Function URLDecode(URLStr As String) As String," & vbCrLf & _
            "Error Number : " & lErrNum & "," & vbCrLf & _
            "Error Source : " & sErrSource & "," & vbCrLf & _
            "Error Description : " & sErrDesc
    App.LogEvent sMsg, vbLogEventTypeError
    
    '** Error 를 발생시킨다.
    Err.Raise lErrNum, sErrSource, sErrDesc

    
    Exit Function
    
    
End Function
저작자 표시 동일 조건 변경 허락
신고

Windows 7 (윈도우 7)에서 비주얼베이직 디자인 버벅, 렉

VB

Windows 7 (윈도우 7)에서 VB 컨트롤 디자인 버벅임에 대한 해결책입니다.

Program Files\Microsoft Visual Studio\VB98 으로 갑니다.


오른쪽. 속성을 누루시고.


'바탕 화면 구성 사용 안 함' 을 체크하시고 확인하시면됩니다.


보통 어플로케이션에서는 Aero기능때문에. 버벅임이 발생합니다.

그럴때 이와같이 호환성체크를 해주시면

됩니다.!


저작자 표시 동일 조건 변경 허락
신고

[VB] CRC32 모듈

VB
클래스 모듈로 작성하여 사용하세요.

자세한사항은 덧글남겨주세요.

소스보기

저작자 표시 동일 조건 변경 허락
신고

폴더 선택창 띄우기

VB


[일반 선언부]

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib "shell32" (lpBI As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Private Type BrowseInfo
   hwndOwner      As Long
   pIDLRoot       As Long
   pszDisplayName As Long
   lpszTitle      As Long
   ulFlags        As Long
   lpfnCallback   As Long
   lParam         As Long
   iImage         As Long
End Type

 


[함수]

Function ReciveFolder() As String

   Dim lpIDList As Long
   Dim sBuffer As String
   Dim szTitle As String
   Dim tBrowseInfo As BrowseInfo

   szTitle = "폴더를 선택하세요."
   With tBrowseInfo
      .hwndOwner = Me.hWnd
      .lpszTitle = lstrcat(szTitle, "")
      .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
   End With

   lpIDList = SHBrowseForFolder(tBrowseInfo)

   If (lpIDList) Then
      sBuffer = Space(MAX_PATH)
      SHGetPathFromIDList lpIDList, sBuffer
      sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
      ReciveFolder = sBuffer
   End If

End Function

저작자 표시 동일 조건 변경 허락
신고

티스토리 툴바