' --------------------------------------------------------
' 문서 내용에 있는 Url를 찾아내어  자동으로 링크를 구성하는 함수
' --------------------------------------------------------  
Function auto_link(text)
 Dim regex_file, regex_http, regex_mail
   
 regex_file= "gz|tgz|tar|gzip|zip|rar|mpeg|mpg|exe|rpm|dep|rm|ram|asf|ace|viv|avi|mid|gif|jpg|png|bmp|eps|mov"
 regex_http = "(http|https|ftp|telnet|news):\/\/(([\xA1-\xFEa-z0-9_\-]+\.[][\xA1-\xFEa-z0-9:;&#@=_~%\?\/\.\,\+\-]+)(\/|[\.]*[a-z0-9]))"
 regex_mail = "([\xA1-\xFEa-z0-9_\.\-]+)@([\xA1-\xFEa-z0-9_\-]+\.[a-z0-9\-\._\-]+[\.]*[\xA1-\xFEa-z0-9\?=]*)"
   
 ' img tag 와 a tag 의 경우 링크가 여러줄에 걸쳐 이루어져 있을 경우
 ' 이를 한줄로 합침 (합치면서 부가 옵션들은 모두 삭제함)
 text = eregi_replace("<(a|img)[^>]*(href|src)[^>]*(" & regex_http & "|mailto:" & regex_mail & ")[^>]*>","<$1 $2=""$3"">", text)
   
 ' 특수문자와 링크시 target 삭제
 text = eregi_replace("&(quot|gt|lt)","!$1", text)
 
 ' html 사용시 Link 보호
 text  = eregi_replace("href=""(" & regex_http & ")""[^>]*>","href=""$2_orig://$3"" target=""_blank"">", text)
 text  = eregi_replace("href=""mailto:(" & regex_mail & ")"">","href=""mailto:$2#-#$3"">", text) 
 text  = eregi_replace("(background|codebase|src)[ \n]*=[\n""' ]*(" & regex_http & ")[""']*","$1=""$3_orig://$4""",text)
 
 '링크가 안된 Url및 Email Address 자동 링크
 text  = eregi_replace("(" & regex_http & ")" ,"<a href=""$1"" target=""_blank"">$1</a>", text)
 text  = eregi_replace("(" & regex_mail & ")","<a href=""mailto:$1"">$1</a>", text)
 ' 보호를 위해 치환된것 복구
 text = eregi_replace("!(quot|gt|lt)","&$1", text)
 text = eregi_replace("(http|https|ftp|telnet|news|mms)_orig","$1", text)
 text = eregi_replace("#-#","@",text)
 ' File Link시 Target을 삭제  
 text = eregi_replace("(\.(" & regex_file & ")"") target=""_blank""","$1", text)
 
 auto_link = text
End Function

' --------------------------------------------------------
' 문자열을 원하는 길이만큼 자르기
' --------------------------------------------------------
function cutstr(long_str, cutting_len)
 dim i, short_str, tail
 
 tail = "..."
 long_str = trim(long_str)

 for i = 0 to cutting_len-1
  if asc(mid(long_str, i+1, 1)) >= 128 then
   kor = kor + 1
  else
   eng = eng + 1
  end if
 next
 if len(long_str) > cutting_len then
  if kor mod 2 = 1 then
   cutting_len = cutting_len - 1
  end if
  short_str = mid(long_str, 1, cutting_len)
  cutstr = short_str & tail
 else
  short_str = mid(long_str, 1, cutting_len)
  cutstr = short_str
 end if
end function

개요

시스템 요구 사항

Link :http://www.microsoft.com/downloads/details.aspx?displaylang=ko&familyid=7b9ba261-7a9c-43e7-9117-f673077ffb3c

MSVCRT.dll 파일이 포함된 Microsoft Visual Basic 6.0 응용 프로그램을 설치하면 컴퓨터가 다시 시작되지 않는다

[scrrun.dll]
Dest=$(WinSysPath)Register=$(DLLSelfRegister)Version=4.0.0.2926
Uses1=MSVCRT.dllCABFileName=ScrRun.cabCABDefaultURL=http://activex.microsoft.com/controls/vb6CABINFFile=ScrRun.inf

[MSVCRT.dll] Dest=$(WinSysPathSysFile)Uses1=

File1=@msvcrt.dll,$(WinSysPathSysFile),,,8/29/02 5:41:08 AM,323072,7.0.2600.1106

사용법
Private Sub Command1_Click()
Dim o As New INIClass
o.FileName = App.Path & "\화일지정"
o.ApplicationKey = "AppKey"

o.SetValue "이름", "값"

MsgBox o.GetValue("이름", "p")
Set o = Nothing
End Sub

'클래스 정의
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Cini"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Declare Function WritePrivateProfileString _
    Lib "kernel32" Alias "WritePrivateProfileStringA" _
        (ByVal lpApplicationname As String, ByVal lpKeyName As Any, _
            ByVal lsString As Any, ByVal lplFilename As String) As Long
Private Declare Function GetPrivateProfileInt Lib _
    "kernel32" Alias "GetPriviteProfileIntA" (ByVal lpApplicationname As String, _
        ByVal lpKeyName As String, ByVal nDefault As Long, _
            ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
    "GetPrivateProfileStringA" (ByVal lpApplicationname As String, _
        ByVal lpKeyName As String, ByVal lpDefault As String, _
            ByVal lpReturnedString As String, ByVal nSize As Long, _
                ByVal lpFileName As String) As Long

Private m_strFile As String ' for file name
Private m_AppName As String '
Public Property Get FileName() As String
    FileName = m_strFile
End Property

Public Property Let FileName(ByVal strFile As String)
    m_strFile = Trim(strFile)
End Property

Private Sub Class_Initialize()
    m_strFile = ""
    m_AppName = ""
End Sub

Public Property Get ApplicationKey() As String
    ApplicationKey = m_AppName
End Property

Public Property Let ApplicationKey(ByVal strAppKey As String)
    m_AppName = Trim(strAppKey)
End Property
Private Function fConvert(str As String) As String
Dim i As Integer
Dim strOP As String
Dim intAsc As Integer

    str = Trim(str)
   
    strOP = ""
   
    For i = 1 To Len(str)
        intAsc = Asc(Mid(str, i, 1))
        If intAsc > 31 And intAsc < 127 Then _
            strOP = strOP & Chr(intAsc)
    Next
    fConvert = strOP
End Function

Public Function GetValue(ByVal keyName As String, ByVal strDefault As String) As String
Dim strVal As String * 100
Dim ret As Long
    ret = GetPrivateProfileString(m_AppName, keyName, strDefault, strVal, Len(strVal), m_strFile)
    If ret <> 0 Then
        GetValue = fConvert(strVal)
    Else
        GetValue = "Error"
    End If
End Function
Public Function SetValue(ByVal keyName As String, ByVal strValue As String) As Boolean
Dim ret As Long

ret = WritePrivateProfileString(m_AppName, keyName, strValue, m_strFile)
If ret = 0 Then
    SetValue = False
    Exit Function
End If
SetValue = True

End Function