VB

[轉貼]把Excel內的Flash找出來另存的VBA程式碼

topcat — Tue, 01 Jul 2008 08:39:00 GMT

有人剛好收到Excel內涵Flash，可是不知道為何無法撥放

小喵在網路上找了一下剛好看到這個可以把Excel檔案中的Flash找出來另存的VBA

提供給大家參考

Sub ExtractFlash()

    Dim tmpFileName As String, FileNumber As Integer
    Dim myFileId As Long
    Dim myArr() As Byte
    Dim i As Long
    Dim MyFileLen As Long, myIndex As Long
    Dim swfFileLen As Long
    Dim swfArr() As Byte
    
    tmpFileName = Application.GetOpenFilename("office File(*.doc;*.xls),*.doc;*.xls", , "確定要分析的 Office 檔")
    
    If tmpFileName = "False" Then Exit Sub
    myFileId = FreeFile
    Open tmpFileName For Binary As #myFileId
    MyFileLen = LOF(myFileId)
    ReDim myArr(MyFileLen - 1)
    Get myFileId, , myArr()
    Close myFileId
    Application.ScreenUpdating = False
    i = 0

    Do While i < MyFileLen
        If myArr(i) = &H46 Then
            If myArr(i + 1) = &H57 And myArr(i + 2) = &H53 Then
                swfFileLen = CLng(&H1000000) * myArr(i + 7) + CLng(&H10000) * myArr(i + 6) + CLng(&H100) * myArr(i + 5) + myArr(i + 4)
                ReDim swfArr(swfFileLen - 1)
                For myIndex = 0 To swfFileLen - 1
                    swfArr(myIndex) = myArr(i + myIndex)
                Next myIndex
                Exit Do
            Else
                i = i + 3
            End If
        Else
            i = i + 1
        End If
    Loop
    myFileId = FreeFile
    tmpFileName = Left(tmpFileName, Len(tmpFileName) - 4) & ".swf"
    Open tmpFileName For Binary As #myFileId
    Put #myFileId, , swfArr
    Close myFileId
    MsgBox "以" & tmpFileName & "名字保存"
    
End Sub

.NET呼叫VB6撰寫元件【釋放資源】的語法

topcat — Wed, 04 Apr 2007 18:31:00 GMT

在撰寫.NET的時候，.NET並不會自動作資源回收，所以呼叫完元件後，需要自己下語法將資源回收

如果呼叫的是.NET所撰寫的COM+元件，那麼資源回收的語法是

Obj.Dispose()

Obj = Nothing

但是如果呼叫的是VB6的元件，那麼不能呼叫Dispose將資源釋放

所以需要用以下的指令將資源釋放(元件服務中的數字會停下來)

System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)

整體的語法如下
Dim obj as Object = CreateObject(“PDemo.CDemo”)

Try

Catch ex As Exception

Finally

System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)

obj = Nothing

End Try

將文字20061226轉成日期方式2006/12/26

topcat — Tue, 26 Dec 2006 11:58:00 GMT

N-Tiers開發方式(ASP/ASP.NET、VB6/VB.NET呼叫使用COM+元件)

topcat — Mon, 28 Aug 2006 19:05:00 GMT

續接：N-Tiers開發方式(COM+元件的註冊、修改)

在元件安裝完成後，接下來的工作就是要如何呼叫使用我們寫好的元件了。我們假設我們寫好的元件的名稱如下：

Package:KDMO1000 Project：PDMOMenu Class： CDMOMenu1(無Transaction) CDMOMenu2(有Transaction) 假設CDMOMenu1中有一個Function是GetNodeName，傳入參數NodeId(整數)，傳回NodeName(字串) GetNodeName(Byval NodeId as Integer) As String

Late Binding：

我這邊所提的使用方式，是使用Late Binding的呼叫方式。也就是說，不會預先將元件註冊到您的ASP.NET的專案中，或者是您的VB.NET的專案中，當系統運作的時候，在動態的從Server把該物件Bind上來使用。這樣做的缺點是，您無法透過obj.就彈出元件內的屬性方法讓您選擇，使用屬性方法的時候都必須自己Keyin進去。但是優點則是，當您的元件有做了變更，您不必去一個一個的專案裡重新的Reference您的元件；另外就是不論您寫的是ASP、ASP.NET、VB、VB.NET，您呼叫元件的方式是一致的。

呼叫元件：

呼叫元件的方式如下：

ASP:
Set obj = CreateObject("PDMOMenu.CDMOMenu1") NodeId = 2 NodeName = obj.GetNodeName(NodeId)

VB:
Dim obj as Object Set obj = CreateObject("PDMOMenu.CDMOMenu1") Dim NodeId as Integer NodeId = 2 Dim NodeName as String NodeName = obj.GetNodeName(NodeId)

ASP.NET/VB.NET

Dim NodeId As Integer = 2 Dim obj As Object = CreateObject("PDMOMenu.CDMOMenu1") Try Dim NodeName As String = obj.GetNodeName(NodeId) Catch ex As Exception Me.lblErrMsg.Text=ex.Message.toString() Finally '資源回收 obj.Dispose() obj = Nothing End Try

.NET呼叫元件需自行釋放元件：

從以上的這些程式碼，可以發現，呼叫元件的過程幾乎相同，使用.NET撰寫時，呼叫的方式更可以簡潔。

當元件被呼叫執行後，可以在【元件服務】中找到該Package中的元件被呼叫而轉起來。如果是用ASP,VB6呼叫元件，可以發現當元件呼叫完成後，元件的轉動會停下來，呼叫中的元件數字也會歸零。但次使用.NET呼叫元件，如果沒有撰寫【Try..Catch..Finally..End Try】並且把【obj.Dispose()】、【obj = Nothing】放在Finally裡，那麼【元件服務】中的元件將會轉不停。這是因為ASP,VB6再程式執行完畢時，會自動的做【資源回收】的動作；但是在.NET中【資源回收】必須經由程式設計者手動的執行，否則需當系統資源不足時啟動GC才能夠真正的回收。

利用Array傳遞參數、變數、條件到COM方法

topcat — Mon, 08 Aug 2005 18:39:00 GMT

利用Array傳遞參數、變數、條件到COM方法

以前建立COM中的Function，往往只要改變參數個數，就會造成機碼不相容的狀況，偶發現一個可以避免的方法

舊 Function A(byval p1 as string, byval p2 as string ,byval p3 as string) as Adodb.Recordet
新 Function A(Parameter as Varinet,Rs as Varent) as Varient
其中，Parameter是一個矩陣，可用來作參數傳遞、多筆維護、SQL查詢條件等。
傳遞【參數、變數】：

比如說有一個Function共有3個參數，分別是RTN,DEPT,AREA
新的寫法如下：
Asp中
RTN = Session(“userrtn”)
DEPT = Session(“userdept”)
AREA = Session(“userarea”)
Dim P(3)
P(1) = RTN
P(2) = DEPT
P(3) = AREA
Set Obj = Server.CreateObject(“Pxxx0000.Cxxx0000”)
RC = Obj.A(P,Rs)

Com 中：
Public Function A(Parameter as Varient,Rs as Varient) as Varient
Dim RTN as String
Dim DEPT as String
Dim AREA as String

If Not(IsArray(Parameter) Then
Goto Err_NotArray
End If

RTN = Parameter(1)
DEPT = Parameter(2)
AREA = Parameter(3)

Set Rs = CreateObject(“ADODB.Recordset”)
With Rs
        .CursorLocation = adUseClientBatch
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .ActiveConnection = conn
End With

SQLTXT = “SELECT * FROM TXXX1234 WHERE (RTN = ‘” & RTN & ”’) AND (DEPT = ‘” & DEPT & ”’) AND (AREA=’” & AREA & ”’)”
Rs.Open SQLTXT

A = “Success”

……………….

==============================================================================
例1：傳遞【條件】

ASP:
Dim P(3,7)
P(1,1) = "WHERE"
P(2,1) = "(SOURCE = "
P(3,1) = "N'2'"
P(1,2) = "OR"
P(2,2) = "SOURCE = "
P(3,2) = "N'5'"
P(1,3) = "OR"
P(2,3) = "SOURCE = "
P(3,3) = "N'6')"
P(1,4) = "AND"
P(2,4) = "(DIVPROD = "
P(3,4) = "N'B'"
P(1,5) = "OR"
P(2,5) = "DIVPROD = "
P(3,5) = "N'I'"
P(1,6) = "OR"
P(2,6) = "DIVPROD = "
P(3,6) = "N'9')"
P(1,7) = "ORDER BY"
P(2,7) = "PROD"
P(3,7) = ""
Set Obj = Server.CreateObject("PXXXXXX.CXXXXXXX")
RC = Obj.ProdMutiLst(P,rs)
===============================================================================

COM:
Set Rs = CreateObject("ADODB.Recordset")

With Rs
        .CursorLocation = adUseClientBatch
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .ActiveConnection = conn
End With
‘基本的SELECT
SQLTXT1 = "SELECT * FROM VSANPRD"

If Not IsArray(Parameter) Then
        SQLTXT1 = SQLTXT1 & ""
Else
        ArrayCount = UBound(Parameter, 2)
        For i = 1 To ArrayCount
                SQLTXT1 = SQLTXT1 & " " & Parameter(1, i) & " " & Parameter(2, i) & " " & Parameter(3, i)
        Next
End If
Rs.Open SQLTXT1

ProdMutiLst = "Success"

例2：傳遞【變數、參數、多筆維護】
ASP:

‘***************************************************************
‘** 此部份傳遞變數(參數)
‘***************************************************************

Dim Parameter(13)
Parameter(1) = OldStudyID
Parameter(2) = StudyID
Parameter(3) = YYYY
Parameter(4) = SName
Parameter(5) = Birthday
Parameter(6) = Father
Parameter(7) = Mother
Parameter(8) = ClassID
Parameter(9) = PostNo
Parameter(10) = City
Parameter(11) = Area
Parameter(12) = Road
Parameter(13) = Memo

‘***************************************************************
‘** 此部份【多筆維護】
‘***************************************************************
Dim Tel()
TelCnt = Request.Form("TelNo").Count
ReDim Tel(2,TelCnt)
For y=1 to TelCnt
Tel(1,y) = Request.Form("TelName").Item(y)
Tel(2,y) = Request.Form("TelNo").Item(y)
Next
Set Obj = Server.CreateObject("PCSLStudent.CCSLStudent0")
RC = Obj.StudentModify(RType,Parameter,Tel,rs)

COM:
‘***************************************************************
‘** 此部份傳遞變數(參數)
‘***************************************************************
OldStudyID = Parameter(1)
StudyID = Parameter(2)
YYYY = Parameter(3)
SName = Parameter(4)
Birthday = Parameter(5)
Father = Parameter(6)
Mother = Parameter(7)
ClassID = Parameter(8)
PostNo = Parameter(9)
City = Parameter(10)
Area = Parameter(11)
Road = Parameter(12)
Memo = Parameter(13)

TelCnt = UBound(Tel, 2)

SQLTXT2 = "INSERT INTO StudentMain (StudyID, YYYY, Name, Birthday, Father, Mother, ClassID, PostNo, City, Area, Road, [Memo]) VALUES ('" & StudyID & "', '" & YYYY & "', '" & SName & "', '" & Birthday & "', '" & Father & "', '" & Mother & "', " & ClassID & ", '" & PostNo & "', '" & City & "', '" & Area & "', '" & Road & "', '" & Memo & "')"
Conn.Execute SQLTXT2

‘***************************************************************
‘** 此部份【多筆維護】
‘***************************************************************
For y = 1 To TelCnt
        TelName = Tel(1, y)
        TelNo = Tel(2, y)
        SQLTXT3 = "INSERT INTO StudentTel (StudyID, TelName, TelNo) VALUES ('" & StudyID & "', '" & TelName & "', '" & TelNo & "')"
        conn.Execute SQLTXT3
Next y

VB中半形轉全形方法

topcat — Mon, 08 Aug 2005 18:36:00 GMT

StrConv(string, conversion, LCID)
半形轉全形：vbWide
全形轉半形：vbNarrow
TT=StrConv("abcd123",vbWide)
==>TT="ａｂｃｄ１２３"