Quantcast
Channel: Visual Basic 6.0 - Superior Source Code
Viewing all 181 articles
Browse latest View live
↧

See matrix content in pure ASCII: Show an array content in the console !

December 7, 2020, 9:05 pm
$
0
0
Source: Gagniuc, Paul A. (2017). Markov Chains: From Theory to Implementation and Experimentation. USA, NJ: John Wiley & Sons. pp. 1–235. ISBN 978-1-119-38755-8.

Function MatrixPaint(w, d,ByVal m AsVariant, a, n,ByVal msg AsString)AsString

Dim e()AsString
ReDim e(1To d)AsString

    d =Len(a)
    q ="|     "
    h ="|_____|"
    l = vbCrLf

For i =(w -1)To d
If i =(w -1)Then t = t & l &"."
        t = t &"_____."
If i = d Then t = t & l &"| "& n &" |  "
Next i

For i = w To d
        e(i)=Mid(a, i,1)
        t = t & e(i)&"  |  "
        h = h &"_____|"
Next i

    t = t & l & h & l

For i = w To d
For j = w To d
            v = Round(m(i, j),2)
            u =Mid(q,1,Len(q)-Len(v))
If j = d Then o ="|"Else o =""
For b = w To d
If j = w And i = b Then
                    t = t &"|  "& e(i)&""
EndIf
Next b
            t = t & u & v & o
Next j
    t = t & l & h & l
Next i

    MatrixPaint = msg &" M["&Val(d - w +1)&","&Val(d - w +1)&"]"& l & t & l

EndFunction
↧
Search

Happy Holidays !

December 23, 2020, 8:36 am
$
0
0
Download from ME
Download from Yandex



OptionExplicit
 
PrivateDeclareFunction PlaySound Lib "winmm.dll" Alias "PlaySoundW" (ByVal lpszName AsLong, ByVal hModule AsLong, ByVal dwFlags AsLong) AsLong
 
Private Const SND_ASYNC = &H1
Private Const pi = 3.14
 
PrivateFunction Draw(v AsLong, cc AsLong) AsBoolean
Dim dh AsSingle, c AsSingle, d AsSingle, x AsSingle, y AsSingle, w AsLong, i AsLong, dx AsSingle, dy AsSingle, _
        gr AsSingle, r AsSingle, g AsSingle, b AsSingle, n AsString
    Rnd v: cc = cc + 2
If cc <= 0 Then
ExitFunction
ElseIf cc <= 100 Then
If cc = 2 Then n = App.Path & "\1.wav": PlaySound StrPtr(n), 0, SND_ASYNC
        dh = 100 / cc: x = Rnd * 0.75 + 0.125 + (cc * ((v And 2) - 1)) / 1000: y = Sin((cc - 2) / 200 * pi) * 0.75
        w = 21 - cc * 0.2: d = 255 / w: c = 0
Do: c = 255 / w: DrawWidth = w: PSet (x, y), RGB(c, c, 0): w = w - 1: LoopWhile w
ElseIf cc < 300 Then
If cc = 102 Then n = App.Path & "\0.wav": PlaySound StrPtr(n), 0, SND_ASYNC
        dh = (cc - 100) / 200: gr = (1 - Cos(dh * pi * 0.25)) * dh: dx = Rnd * 0.75 + 0.125 + ((v And 2) - 1) / 10
        dy = 0.75 - gr: i = Rnd * 100 + 200: gr = 1 - 0.2 ^ (dh * 5): dh = 1 - dh
        r = Rnd * 0.8 + 0.2: g = Rnd * 0.8 + 0.2: b = Rnd * 0.8 + 0.2
If cc < 150 Then
            b = (1 - (cc - 100) / 50) * 3
For w = (cc - 100) * 2 To 1 Step -1
                DrawWidth = w * 5: c = cc / w * b: PSet (dx, dy), RGB(c * r, c * g, c * b)
Next
EndIf
DoWhile i
            c = Rnd * pi * 2: d = gr * (Rnd * 0.8 + 0.2) * 0.5: x = Cos(c) * d + dx: y = Sin(c) * d + dy
            w = (dh * 6) * Abs(Sin((cc + i) / 10 * pi)) + 1: c = 0
Do: c = 512 / w * dh: DrawWidth = w: PSet (x, y), RGB(c * r, c * g, c * b): w = w - 1: LoopWhile w
            i = i - 1
Loop
Else: Draw = True: cc = 0: v = v - Rnd * 100
EndIf
EndFunction
PrivateSub Form_Click()
    Unload Me
EndSub
PrivateSub Form_Load()
    Randomize
EndSub
PrivateSub Form_Resize()
    Scale (0, 1)-(1, 0)
EndSub
PrivateSub tmrTimer_Timer()
Static a1 AsLong, a2 AsLong, c1 AsLong, c2 AsLong
If a1 = 0 Then a1 = -(Rnd * 100) - 1: a2 = a1 - 2: c2 = -150
Call Cls: Draw a1, c1: Draw a2, c2
EndSub


↧
↧

Numerical or financial Math: VBA / EXCEL / VB6

January 12, 2021, 11:08 pm
$
0
0
Download from ME
Download from SOURCE

Classical binomial model

 CRR_optimized.zip
    Simplifying algebraic terms in the binomial model of Cox-Ross-Rubinstein for american options the
    speed against the usual solution (cf Haug's book for a code) is improved by a factor of 40 - 50.
    That file contains the Excel code (with inline comments as user docu) and examples for testing.
    But it does not heal the combinatorical curse of double looping for American options ...

 LeisenReimer_NP.zip
    A binomial Leisen-Reimer tree avoids the oscillations of the usual binomial trees through a proper
    choice of the tree parameters. Besides that the geometry is the same as for CRR the speed
    is improved by a factor better than 40. The Excel file contains code and examples for testing.

 LeisenReimer_properties.zip
    The code for the above has been translated into a DLL (C source code included) for better speed to
    play with the properties of the model within Excel (like extrapolation or what may happen through
    numerical differentiation). I am somewhat too lazy to comment the various results.
    Speed is about 880 prices per second for a 257 step tree and a 4-point Richardson extrapolation
    gives an exactness of 6 - 7 digits for the european case (starting with 65 steps), while extrapolation
    is not really helpfull in the case of early exercise.

Pricing

 BS&Vol_CodyMiller.xls.zip 
    This uses an improved version of the former through a better cumulative normal distribution (due to Miller and Cody) and gives almost IEEE correctness in Excel (relativ error ~ 2 DBL_EPSILON). On my Office PC it needs ~ 1 sec for 100000 prices, computing volatility needs 10 times more. It also works for non-practical situations of data (strike=1.5*spot, time=some days, vol ~ 0.25%).

 BS&Vol.xls.zip, BS&Vol_increased.xls.zip
    Excel sheets to compute Black-Scholes prices and retrieve volatility. Yes, there are many such files. The point is: these here are robust (working with the option premium and switch to 'normed' situations) and the volatility is computed in the spirit of a fairly good initial guess (similar to Jaeckel). The 2nd Excel file shows how one can increase the usual solution for vol and still gets given prices. This (partially) solves the problem, that vol numerical is not well-defined as the inverse of a price. It even works in extreme situations (like vol ~ 10% and small time or very far off the money). A more sound solution has to use C code (or similar), but it is just a stripped down version of that. Of course that depends on the quality of the pricing function and to judge it one can not use Excel.

  perf_tst.zip
    Performance test for Black-Scholes prices for pure VBA vs a C DLL (docu)

 pdf_pricing.zip
    BS pricing through integrating the pay off against the risk neutral density, both over spots and
    logarithmic moneyness (i.e. Breeden-Litzenberger). That Excel sheet uses the DLL of the
    integrator in integratorXL. A Maple sheet (as pdf) is included explaining the manipulations and
    gives estimations, where to cut off to restrict to integration to finite intervalls

 CarrMadan_Fourier.pdf
    Simple example for Madan & Carr's Fourier method on option pricing: the case of constant volatility (which means: Fourier method for Black-Scholes) using integration (instead of FFT).

Stochastic volatility / Heston

 Heston93-Check.pdf
    Heston's model using characteristic functions (Maple)

 Heston93_opt.zip
    Optimized Excel solution for Heston's model using Gauss integration (undiscounted option values), including reference values (from Maple) and graphics for the integrands (VolVol = 0 is missing), short documentation.

 Heston93_pdf.zip
    Smiles and probability function (RND) for Heston's model with Excel; if strikes are extreme that may fail for the smiles

 Heston93_withDLL.zip
    DLL version for Heston in Excel: one fast and one exact solution, gives back prices and/or volatility, VolVol=0 is still missing (as I found to allow reaching it my solution become instable due to oscillation)

 Heston-MC.pdf
    A Monte-Carlo simulation for the Heston market model in Maple, somewhat slow ...
    and I should have added 'reflecting/absorbing barrier' to be chosen ...

 Heston_MC_hf_10.pdf
    A speed-improved version of the above in Maple 10, almost 100 times faster


Stochastic volatility / other models

 NIG_tiny_withDLL.zip
    Normal Inverse Gauss option pricer (with Esscher transform correction), Excel + DLL, and
    a Maple worksheet with short explanations, cf Schoutens book "Levy Proccess in Finance"

 VG_Pricer_short(Maple).pdf
    A 'brute' option pricer for the Variance Gamma model (Madan, Carr, Chang 1998) in Maple

 VG_small.zip
    Variance Gamma model in Excel + DLL; it uses a gamma distribution pdfGamma(a,x)
    which accepts large numerical arguments, short docu

Correction for VG (both Maple and Excel+DLL, 02. Jan 2014)
    The paper has a typo. To get the correct values one has to use  - theta instead of + theta.
    With that change of sign on input level the values are correct (without modifying the code),
    see the discussion here.


Volatility smile

 GatheralSmileExample.zip
    Example for Gatheral's parsimonious arbitrage-free implied volatility parametrization, in Maple as pdf (24 Oct 2004: corrected some errors in that sheet)

 GatheralSmile_Vola.zip
    Fitting Gatheral's model to a given, empirical volatility smile. The estimates for initial parameters are computed from data only. This is a pure Excel solution with least square fitting likewise either through Excel's solver or a Levenberg-Marquardt method included as VBA project, short docu

 GatheralSmile_Vola_DLL.zip
    This is the same as above, but uses a DLL for fitting to speed things up.

 PatSmile.zip
    Continous family of smiles produced by the SABR model of Pat Hagan et al

 SABR.pdf
    Code in C and Visual Basic SABR_Code_VB_and_C.txt  and some graphs for the SABR model various

 European_Dividend_Alan_Example.pdf
    Numerical example for european options and discontinous dividends, valuation method due to Alan Lewis

 ExtremeSmiles.htm
    Example using actual historical data for 'extreme' smiles and vol term structures after crashes

 VolaTermDAX.zip
    Example using actual historical data for 'visible volatility ATM term structure', if front month expires

 Div1Year.gif
    Dividend strip for the Swiss market regarding tax (both tax variants) in money and SMI points

 Exane.gif
    Example for sticky strike vs sticky delta from exane.com

Risk neutral density

 a_brute_way_to_get_a_RND_from_option_prices.pdf
    Using polynomial approximations and normal distribution for tails one can find a RND (over log
    space), which is good enough to recover option prices and to get reasonable statistical results.

 From_a_brute_RND_to_a_NIG_estimation.pdf
    Having descriptive statistics for a RND one can fit a normal inverse Gauss model against option prices

 RND_statistics_example.zip
    This Excel sheet (with pure VBA code) shows, how one can estimate the descriptive statistics for
    a RND directly from option prices using an approach similar to the VIX construction (where I use
    a somewhat different discretization), no interpolation of volatility or prices is needed.

Here is a sketchy explanation for the method: Explaining the method in RND_statistics_example.pdf.


Numerics / Excel

 Testing Excel 2010.pdf
    This is a test report about Excel 2010 (beta), which seems to be a good improvemet over older versions. For testing essentially taking an input in decimal number it is converted to the nearest IEEE 754 double, then it is feed to Maple to be evaluated with higher precision, which then is rounded to the nearest IEEE again to have a correct result (as far as it can be correct).  Only then it makes sense to compare against some floating point result given by Excel. For that a work around for the limitation of 15 decimal places in Excel is needed and provided as well.


Numerics / Excel / various financial stuff

 simpleGarch11.zip
    A simple GARCH(1,1) in Excel (using optimizer for the maximum likelihood and the statistics
    for the time series) to estimate DAX spot volatility

 Hist_Vol.zip
    How to compute historical volatility in Excel with a variable time frame


Numerics / Excel / fitting

 LMfit_logistic.zip
    Example for Levenberg-Marquardt in Excel (pure VBA), which shows the essential algorithm
    (ie: the linear algebra and the numerics), short documentation

 LMfit3_with_weights.zip
    It contains the complete usual Levenberg-Marquardt in Excel (pure VBA, dim = 1) and a version,
    which allows weightings of data points

 LeastSquareFitting.zip
    An Excel interface to a DLL (containing a Levenberg-Marquardt method) for fitting curves against
    data and estimating the parameters of the curve. The objective function is given within VBA and
    can be chosen freely, short docu. As example Gatheral's SVI volatility smile is treated.

 LMfit_logistic.zip
    Example for Levenberg-Marquardt in Excel (pure VBA), which shows the essential algorithm
    (ie: the linear algebra and the numerics), short documentation

 LMfit3_with_weights.zip
    It contains the complete usual Levenberg-Marquardt in Excel (pure VBA, dim = 1) and a version,
    which allows weightings of data points

 LeastSquareFitting.zip
    An Excel interface to a DLL (containing a Levenberg-Marquardt method) for fitting curves against
    data and estimating the parameters of the curve. The objective function is given within VBA and
    can be chosen freely, short docu. As example Gatheral's SVI volatility smile is treated.


Numerics / Excel / cumulative normal distribution

 cdfN2010_June.zip
    This is my best cdf Normal in pure VBA. Absolute errors are fine, of course. The relative errors
    are below 2 DBL_EPSILON or 3 ULPs over the full range (to be seen for negative inputs only)
    as far as I am aware of it (i.e. I have no 'proof' for that, just tests, see the graphical test results).
    Testing was done as sketched in the report "Testing Excel 2010.pdf" (so: precisely at IEEE level).
    This is even much better than Excel 2010 (as of today), though I used my good old Excel 2000,
    which I prefer (and yes, tiny relative errors at the left tail may be a little bit a matter of taste ...).
    A short test docu sketches, how explicit test values and results can be achieved using Maple.
 xmasNormDist.zip cdf Normal (following George Marsaglia) for Excel, pure VBA with 19 digits (using data type CDec),short documentation

 cdfN_GMsimple_Test.zip
    cdf Normal (following George Marsaglia) for Excel (pure VBA), simplified version, precise test
    data calculated using Maple

 bivariateNormal_Series.zip
    This Excel sheet contains fast codes for the cumulative normal distribution in dimensions
    1 and 2 through series developments up to machine precision in Excel, short documentation

 cdfN_trivariate_mini.zip
    This Excel sheet (with DLL for integration) compares implementations for the cumulative normal
    distribution up to dimension 3 (references are given in the code and the short documentation), so
    it is a kind of study (but not meant to be a complete overview). For high precision one would have
    to switch to other environments of course, for example one can use LCC.

Numerics / Excel / random number generation

 RNG_normal.xls.zip
    This is an Excel solution with DLL for 3 very fast and good pseudo-random generators for normal
    distributed numbers (Ziggurat [Marsaglia], ZIGNOR [Doornik], FastNorm3 [Wallace]). Speed is
    about 1 sec for 10 Mio numbers.


Numerics / Excel / more ...

 Brent_netlib.zip
    Excel / VBA code for Brent's method to find Zeros or Minima in dimension 1. That are ports from
    the Netlib C library. The original C sources have reasonable inline comments and serve as docu,
    they are included.

 integratorXL.zip
    Numerical quadrature for Excel using a DLL which takes function names as arguments, short docu
    applications: pricing by the risk neutral density (see above) and bi- and tri-variate normal densities
    (to be done).

 integratorXL_doubleIntegral.zip
    The above integrator can be used to compute double integrals in Excel and as an example this is
   shown for the cumulative bivariate normal distribution starting from a Gauss kernel only, short docu.

 integrator_GaussKronrod.zip
    An adaptive Gauss-Kronrod integrator, purely in VBA.

 FFT_xl.zip
    Fast Fourier Transform in Excel with VBA, that does not use Excel's slow and ugly built-in solution.The docu explains conventions used, handling is shown by examples through a workbook.


Numerics / Excel / functional

 wrapGSL.zip
    Wrapper to use GSL from Excel: files
    There is an Excel sheet enclosed how to work with function names as arguments (as Excel/VBA
    does not have function pointers) for special functions and complex functions. One needs the free
    GNU GSL lib to be installed and for a reasonable handling one should consult the documentation
    for namings, arguments etc. That are the binary GSL files (DLLs) needed:  gslWIN32_1.3.zip
    Documentation has to be done ...

 Function_as_Arguments_in_Excel.zip
    Several ways how to live with functions as arguments in Excel, VBA does not have this. Usually I do not work with classes, but here it is seems to be one way out. That sheet grew from a discussion on a forum, the main example is integration by Gauss-Legendre.

 Working_with_Array_Functions_and_DLLs_in_Excel_VBA.pdf
    This is a tutorial how to work with numerical arrays using Excel and DLLs: reading and writing from VBA to DLL and vice versa (so it covers the old question "how to pass array data?"), using functions having array arguments or array outputs. It does not use SDK and all the overhead. And it is only through commented examples in C and VBA, so it is a bit technical, but practical (and not thought as an introduction to DLL & VBA). Here are the sources (Excel sheet, C code and DLL).

  Reading_and_Writing_Arrays_across_Excel_and_DLLs.pdf
    That tutorial is a short variant of "Working with Array Functions" having just implementation in mind. Here are the sources (Excel sheet, C code and DLL).

  Reading_and_writing_strings_between_VBA_and_DLLs.txt
    This is for working with C-strings between VBA and a DLL, quite similar to the numerical case above. Here are the sources (Excel sheet, C code and DLL).

All the VBA projects are unprotected while the source code for DLLs usually is not provided.
Many are just pure VBA code, but if a sheet uses a DLL then set the correct pathes within the
project. Open Excel's debug window to watch results being printed out.

22 Feb 2015:  uploaded BS&Vol_CodyMiller.zip

23 Dec 2010:  uploaded Reading_and_writing_strings_between_VBA_and_DLLs.zip

24 Jun 2010: uploaded cdfN2010_June

31 Mar 2010: uploaded  Testing Excel 2010.pdf

31 Oct 2009: uploaded BS&Vol

17 Aug 2006: uploaded Integrator_GaussKronrod

11 May 2006: uploaded some files around the risk neutral density from option prices

18 Jan 2006: uploaded high precision for cumulative normal in dim <= 3 to the LCC subdirectory

18 Dec 2005: uploaded cdfN_trivariate_mini.zip

17 Dec 2005: reorganized to give a better overview

12 Dec 2005: linked to my LCC files - giving 100 digits precision

12 Nov 2005: uploaded Reading_and_Writing_Arrays_across_Excel_and_DLLs.pdf

01 Nov 2005: uploaded Working_with_Array_Functions_and_DLLs_in_Excel_VBA.pdf

31 Oct 2005: uploaded LeastSquareFitting

30 Oct 2005: uploaded Function_as_Arguments_in_Excel

23 Oct 2005: uploaded gslWIN32_1.3.zip (the DLLs for GSL)

06 Oct 2005: uploaded GatheralSmile_Vola_DLL, a DLL version

06 Oct 2005: uploaded GatheralSmile_Vola

06 Aug 2005: uploaded LeisenReimer_properties

09 Jul 2005: uploaded LeisenReimer_NP

08 Jul 2005: uploaded CRR_optimized

07 Jul 2005: uploaded Heston_MC_hf_10.pdf (speed in Maple 10 improved)

28 May 2005: uploaded Levenberg-Marquardt with weights

27 May 2005: uploaded RNG_normal

02 Apr 2005: uploaded Brent_netlib

24 Mar 2005: uploaded IntegratorXL_doubleIntegral

19 Feb 2005: uploaded FFT_xl

30 Jan 2005: uploaded bivariateNormal_Series (contains the deleted cdfN_Marsaglia_Taylor.txt)

28 Dec 2004: uploaded pdf_pricing.zip

29 Nov 2004: uploaded cdfN_Marsaglia_Taylor.txt

31 Oct 2004: uploaded integratorXL and ExtremeSmiles.htm

24 Oct 2004: corrected some errors in GatheralSmileExample.zip

22 Oct 2004: uploaded simpleGarch11.zip

June 2004: Yahoo killed my web space, so I use this one from now on ...


This software is provided "as is" and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the author be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage.

Source:

↧

ALGLIB: Numerical analysis and data processing library in VB6 (by Dr. Sergey Bochkanov)

January 14, 2021, 10:29 pm
$
0
0
Download from ME
Download from VBForums

102 modules containing several hundred advanced mathematical functions written by Dr. Sergey Bochkanov. Some of the functions, include:
  • Decision forest classifier (regression model)
  • K-means++ clustering
  • Linear discriminant analysis
  • Linear models
  • Logit models
  • Basic neural network operations
  • Neural network ensemble models
  • Neural network training
  • Principal component analysis
  • Ordinary differential equation solver
  • Fast real/complex convolution
  • Fast real/complex cross-correlation
  • Real/complex FFT
  • Real Fast Hartley Transform
  • Adaptive 1-dimensional integration
  • Gauss-Kronrod quadrature generator
  • Gaussian quadrature generator
  • Inverse distance weighting: interpolation/fitting
  • Linear and nonlinear least-squares solvers
  • Polynomial interpolation/fitting
  • Parametric spline interpolation
  • Rational interpolation/fitting
  • 1D spline interpolation/fitting
  • 2D spline interpolation
  • Level 2 and Level 3 BLAS operations
  • Bidiagonal SVD
  • Eigensolvers
  • Sherman-Morrison update of the inverse matrix
  • LDLT decomposition
  • Determinant calculation
  • Random matrix generation
  • Matrix inverse
  • Real/complex QR
  • LQ
  • bi(tri)diagonal
  • Hessenberg decompositions
  • Condition number estimate
  • Schur decomposition
  • Determinant of a symmetric matrix
  • Symmetric inversion
  • Generalized symmetric eigensolver
  • Condition number estimate for symmetric matrices
  • Singular value decomposition
  • LU and Cholesky decompositions
  • ASA bound constrained optimizer
  • Conjugate gradient optimizer
  • Limited memory BFGS optimizer
  • Improved Levenberg-Marquardt optimizer
  • Nearest neighbor search: approximate and exact
  • Dense linear system solver
  • Symmetric dense linear system solver
  • Airy functions
  • Bessel functions
  • Beta function
  • Chebyshev polynomials
  • Dawson integral
  • Elliptic integrals
  • Exponential integrals
  • Fresnel integrals
  • Gamma function
  • Hermite polynomials
  • Incomplete beta function
  • Incomplete gamma function
  • Jacobian elliptic functions
  • Laguerre polynomials
  • Legendre polynomials
  • Psi function
  • Trigonometric integrals
  • Binomial distribution
  • Chi-Square distribution
  • Pearson/Spearman correlation coefficients
  • Hypothesis testing: correlation tests
  • Descriptive statistics: mean
  • variance, etc.
  • F-distribution
  • High quality random numbers generator
  • Hypothesis testing: Jarque-Bera test
  • Hypothesis testing: Mann-Whitney-U test
  • Normal distribution
  • Poisson distribution
  • Hypothesis testing: sign test
  • Student's t-distribution
  • Hypothesis testing: Student's t-test
  • Hypothesis testing: F-test and one-sample variance test
  • Hypothesis testing: Wilcoxon signed rank test.

Original content from Dr. Sergey Bochkanov:

Contents

Introduction
Getting started with ALGLIB
FAQ
AP library description
ALGLIB reference manual

Introduction

Sections

  • ALGLIB license
  • Documentation license
  • Reference Manual and User Guide
  • Acknowledgements

ALGLIB license

ALGLIB is a free software which is distributed under a GPL license - version 2 or (at your option) any later version. A copy of the GNU General Public License is available at http://www.fsf.org/licensing/licenses

Documentation license

This reference manual is licensed under BSD-like documentation license:
Copyright 1994-2009 Sergey Bochkanov, ALGLIB Project. All rights reserved.
Redistribution and use of this document (ALGLIB Reference Manual) with or without modification, are permitted provided that such redistributions will retain the above copyright notice, this condition and the following disclaimer as the first (or last) lines of this file.
THIS DOCUMENTATION IS PROVIDED BY THE ALGLIB PROJECT "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE ALGLIB PROJECT BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS DOCUMENTATION, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Reference Manual and User Guide

ALGLIB Project provides two sources of information: ALGLIB Reference Manual (this document) and ALGLIB User Guide.
ALGLIB Reference Manual contains full description of all publicly accessible ALGLIB units accompanied with examples. Reference Manual is focused on the source code: it documents units, functions, structures and so on. If you want to know what unit YYY can do or what subroutines unit ZZZ contains Reference Manual is a place to go. Free software needs free documentation - that's why ALGLIB Reference Manual is licensed under BSD-like documentation license.
Additionally to the Reference Manual we provide you User Guide. User Guide is focused on more general questions: how fast ALGLIB is? how reliable it is? what are the strong and weak sides of the algorithms used? We aim to make ALGLIB User Guide an important source of information both about ALGLIB and numerical analysis algorithms in general. We want it to be a book about algorithms, not just software documentation. And we want it to be unique - that's why ALGLIB User Guide is distributed under less-permissive personal-use-only license.

Acknowledgements

ALGLIB was not possible without the contribution of next open source projects:
  • LAPACK
  • Cephes
  • GNU MP
  • MPFR

Getting started with ALGLIB

Sections

    FAQ

    Sections

    • What version of Visual Basic are the algorithms translated into?
    • Why is the goto operator used in some programs?
    • What is the AP library?
    • Why do some algorithms (for instance, optimization methods) use reverse communication instead of function pointers, delegates and other means of my programming language?
    • What is ALGLIB aimed at?
    • What is the difference between ALGLIB and other similar projects?
    • What is AlgoPascal?

    What version of Visual Basic are the algorithms translated into?

    The algorithms are translated into VBA, but in general are compatible with VB6.

    Why is the goto operator used in some programs?

    In many programming languages there is control operator continue, but it is absent in VB. In AlgoPascal, this operator appears from time to time. The goto operator is used to replace it and go to the next iteration of the cycle.

    What is the AP library?

    AP library is a generic name for a set of libraries in several programming languages performing low-level tasks depending on specific programming languages. The AP library carries out tasks such as working with dynamic one- and multidimensional arrays in languages which do not support this data type, contains implementation of basic linear algebra algorithms, etc. The library is distributed as source codes under GPL 2+ license (GPL 2 or later). The library is attached to the ALGLIB package.

    Why do some algorithms (for instance, optimization methods) use reverse communication instead of function pointers, delegates and other means of my programming language?

    Optimization, integration and other similar methods are united by one common trait. They need to have a way of calculating the meaning of a function defined by the user at a point defined by the method.
    The most convenient way of solving this problem is transferring a function pointer into the module. However bear in mind that ALGLIB package is written using pseudocode that is automatically translated into different programming languages. While each language has its own function pointer analog that is often different from other languages. When the ALGLIB pseudocode was developed, at some point is became clear that adding function pointers in it will be very complex as this feature is implemented differently in every language. This is why reverse communication was chosen as a different kind of solution.

    What is ALGLIB aimed at?

    It is aimed at creating a convenient and efficient multilingual scientific software library.

    What is the difference between ALGLIB and other similar projects?

    The ALGLIB package:
    • is a multilingual project. The main feature of the project is that each algorithm is represented by programs in several languages and the language list is the same for every algorithm. This is the main advantage of the site before other similar collections - one algorithm, several languages, identical functionality in each language.
    • is focused on numerical analysis. There are some other directions in the project but numerical analysis is a priority.
    • is easy to use. To use the ALGLIB package you don't need to learn an unknown programming language, attach additional external libraries or work with an inconvenient interface to a code written in another programming language.

    What is AlgoPascal?

    AlgoPascal is a programming language, designed particularly for this project. The programs, written in this language, are processed by an automatic translator and translated into other programming languages. Almost all ALGLIB source is produced by the AlgoPascal translator.

    AP library description

    Sections

    • Introduction
    • Compatibility
    • Constants
    • Functions
    • Complex numbers operations

    Introduction

    The document describes a VBA version of the AP library. The AP library for VBA contains a basic set of mathematical functions needed to compile ALGLIB package. The library includes the only module ap.bas.

    Compatibility

    This library is developed for VBA only.

    Constants

    MachineEpsilon
    The constant represents the accuracy of machine operations times some small number r>1.
    MaxRealNumberThe constant represents the highest value of the positive real number, which could be represented on this machine. The constant may be taken "oversized", that is real boundary can be even higher.
    MinRealNumber
    The constant represents the lowest value of positive real number, which could be represented on this machine. The constant may be taken "oversized", that is real boundary can be even lower.

    Functions

    Public Function MaxReal(ByVal M1 As Double, ByVal M2 As Double) As Double
    Returns the maximum of two real numbers.
    Public Function MinReal(ByVal M1 As Double, ByVal M2 As Double) As Double
    Returns the minimum of two real numbers.
    Public Function MaxInt(ByVal M1 As Long, ByVal M2 As Long) As Long
    Returns the maximum of two integers.
    Public Function MinInt(ByVal M1 As Long, ByVal M2 As Long) As Long
    Returns the minimum of two integers.
    Public Function ArcSin(ByVal X As Double) As Double
    Returns arcsine (in radians).
    Public Function ArcCos(ByVal X As Double) As Double
    Returns arccosine (in radians).
    Public Function SinH(ByVal X As Double) As Double
    Returns hyperbolic sine.
    Public Function CosH(ByVal X As Double) As Double
    Returns hyperbolic cosine.
    Public Function TanH(ByVal X As Double) As Double
    Returns hyperbolic tangent.
    Public Function Pi() As Double
    Returns the value of π.
    Public Function Power(ByVal Base As Double, ByVal Exponent As Double) As Double
    Returns Base raised to a power of Exponent (introduced for compatibility).
    Public Function Square(ByVal X As Double) As Double
    Returns x2.
    Public Function Log10(ByVal X As Double) As Double
    Returns common logarithm from X.
    Public Function Ceil(ByVal X As Double) As Double
    Returns the smallest integer bigger or equal to X.
    Public Function RandomInteger(ByVal X As Long) As Long
    Returns a random integer between 0 and I-1.
    Public Function Atn2(ByVal Y As Double, ByVal X As Double) As Double
    Returns an argument of complex number X + iY. From interval from -π to π.

    Complex numbers operations

    As there is no operator overloading in Visual Basic 6.0, operations with complex numbers could not be implemented as easy as with built-in data type. Therefore Complex data type is defined in a library. It is a record with two real number fields x and y, and all the operations are performed with the use of special functions implementing addition, multiplication, subtraction and division. An input can be complex or real, and output is complex. These functions are listed below.
    Public Function C_Add(Z1 As Complex Z2 As Complex):Complex
    Public Function C_AddR(Z1 As Complex R As Double):Complex
    Calculate Z1+Z2 or Z1+R.
    Public Function C_Sub(Z1 As Complex Z2 As Complex):Complex
    Public Function C_SubR(Z1 As Complex R As Double):Complex
    Public Function C_RSub(R As Double, Z1 As Complex):Complex
    Calculate Z1-Z2, Z1-R or R-Z1.
    Public Function C_Mul(Z1 As Complex Z2 As Complex):Complex
    Public Function C_MulR(Z1 As Complex R As Double):Complex
    Calculate Z1*Z2 or Z1*R.
    Public Function C_Div(Z1 As Complex Z2 As Complex):Complex
    Public Function C_DivR(Z1 As Complex R As Double):Complex
    Public Function C_RDiv(R As Double, Z2 As Complex):Complex
    Calculate Z1/Z2, Z1/R or R/Z2. Modulus calculation is performed using so called "safe" algorithm, that could never cause overflow when calculating intermediate results.
    Public Function C_Equal(Z1 As Complex Z2 As Complex):Boolean
    Public Function C_EqualR(Z1 As Complex R As Double):Boolean
    Public Function C_NotEqual(Z1 As Complex Z2 As Complex):Boolean
    Public Function C_NotEqualR(Z1 As Complex R As Double):Boolean
    Compare Z1 and Z2 or Z1 and R.
    Public Function C_Complex(X As Double):Complex
    Converts a real number into equal complex number.
    Public Function C_Opposite(Z As Complex):Complex
    Returns -Z.
    Public Function AbsComplex(Z As Complex):Double
    Returns the modulus of complex number z. Modulus calculation is performed using so called "safe" algorithm, that could never cause overflow when calculating intermediate results.
    Public Function Conj(Z As Complex):Complex
    Returns complex conjugate to z.
    Public Function CSqr(Z As Complex):Complex
    Returns the square of z.

    ALGLIB reference manual

    Packages and units


    DataAnalysis package
    dforest Decision forest classifier (regression model)
    kmeans K-means++ clustering
    lda Linear discriminant analysis
    linreg Linear models
    logit Logit models
    mlpbase Basic neural network operations
    mlpe Neural network ensemble models
    mlptrain Neural network training
    pca Principal component analysis
     
    DiffEquations package
    odesolver Ordinary differential equation solver
     
    FastTransforms package
    conv Fast real/complex convolution
    corr Fast real/complex cross-correlation
    fft Real/complex FFT
    fht Real Fast Hartley Transform
     
    Integration package
    autogk Adaptive 1-dimensional integration
    gkq Gauss-Kronrod quadrature generator
    gq Gaussian quadrature generator
     
    Interpolation package
    idwint Inverse distance weighting: interpolation/fitting
    lsfit Linear and nonlinear least-squares solvers
    polint Polynomial interpolation/fitting
    pspline Parametric spline interpolation
    ratint Rational interpolation/fitting
    spline1d 1D spline interpolation/fitting
    spline2d 2D spline interpolation
     
    LinAlg package
    ablas Level 2 and Level 3 BLAS operations
    bdsvd Bidiagonal SVD
    evd Eigensolvers
    inverseupdate Sherman-Morrison update of the inverse matrix
    ldlt LDLT decomposition
    matdet Determinant calculation
    matgen Random matrix generation
    matinv Matrix inverse
    ortfac Real/complex QR, LQ, bi(tri)diagonal, Hessenberg decompositions
    rcond Condition number estimate
    schur Schur decomposition
    sdet Determinant of a symmetric matrix
    sinverse Symmetric inversion
    spdgevd Generalized symmetric eigensolver
    srcond Condition number estimate for symmetric matrices
    svd Singular value decomposition
    trfac LU and Cholesky decompositions
     
    Optimization package
    minasa ASA bound constrained optimizer
    mincg Conjugate gradient optimizer
    minlbfgs Limited memory BFGS optimizer
    minlm Improved Levenberg-Marquardt optimizer
     
    Other package
    nearestneighbor Nearest neighbor search: approximate and exact
     
    Solvers package
    densesolver Dense linear system solver
    ssolve Symmetric dense linear system solver
     
    SpecialFunctions package
    airyf Airy functions
    bessel Bessel functions
    betaf Beta function
    chebyshev Chebyshev polynomials
    dawson Dawson integral
    elliptic Elliptic integrals
    expintegrals Exponential integrals
    fresnel Fresnel integrals
    gammafunc Gamma function
    hermite Hermite polynomials
    ibetaf Incomplete beta function
    igammaf Incomplete gamma function
    jacobianelliptic Jacobian elliptic functions
    laguerre Laguerre polynomials
    legendre Legendre polynomials
    psif Psi function
    trigintegrals Trigonometric integrals
     
    Statistics package
    binomialdistr Binomial distribution
    chisquaredistr Chi-Square distribution
    correlation Pearson/Spearman correlation coefficients
    correlationtests Hypothesis testing: correlation tests
    descriptivestatistics Descriptive statistics: mean, variance, etc.
    fdistr F-distribution
    hqrnd High quality random numbers generator
    jarquebera Hypothesis testing: Jarque-Bera test
    mannwhitneyu Hypothesis testing: Mann-Whitney-U test
    normaldistr Normal distribution
    poissondistr Poisson distribution
    stest Hypothesis testing: sign test
    studenttdistr Student's t-distribution
    studentttests Hypothesis testing: Student's t-test
    variancetests Hypothesis testing: F-test and one-sample variance test
    wsr Hypothesis testing: Wilcoxon signed rank test



    Sources:
    1. https://www.alglib.net/
    2. https://sites.google.com/site/chandanprogrammingdocs/platforms-frameworks/alglib
    3. https://newtonexcelbach.com/2010/05/20/installing-alglib-with-excel-vba/


    Here you can download GPL-licensed version of ALGLIB. Commercial users may use GPL-licensed code as unlimited trial version. But if you want to distribute something that includes GPL-ed code, you have to either distribute it under GPL too or buy commercial license.
    3.x branch
    Change Log
    alglib-3.1.0.cpp        zip tgz        C++ version
    alglib-3.1.0.csharp        zip tgz        C# version (100% managed code)
     
    pre-3.x releases
    Pre-3.x releases are not compatible with 3.x branch;
    however, they will be there for languages which were not ported to 3.x yet
    alglib-2.6.0.mpfr.zip Multiple precision version (MPFR)
    alglib-2.6.0.freepascal.zip FreePascal version
    alglib-2.6.0.delphi.zip Delphi version
    alglib-2.6.0.vb6.zip VBA version
    ↧

    Working with pointers - VB6 (by Krivous Anatoly Anatolevich)

    February 14, 2021, 8:43 am
    $
    0
    0
    Often there are situations when you need to get data having only the address (for example, in WndProc, HookProc). Usually, simply copy the data via CopyMemory the structure after changing data and copy it back. If the structure is large, it will be a waste of resources to copy into structure and back. In languages such as C ++ is all done easily with the help of pointers, written something like newpos = (WINDOWPOS *) lparam. Nominally VB6 does not work with pointers, but there are a few workarounds.

    PublicDeclareFunction GetMem4 Lib "msvbvm60" (src As Any, Dst As Any) AsLong
    PublicDeclareFunction ArrPtr Lib "msvbvm60" Alias "VarPtr" (src() As Any) AsLong
    For a start I will give the necessary declarations:
    Code:

    PrivateType Vector
        X AsSingle
        Y AsSingle
    EndType
    PrivateType TestRec
        Name AsString
        Value AsLong
        Position As Vector
        Money AsDouble
    EndType
     
    PrivateSub Form_Load()
    Dim tr As TestRec
        Test tr
    EndSub
     
    PrivateFunction Test(Pointer As TestRec, OptionalByVal nu AsLong)
    Dim q As TestRec, z As TestRec
     
        q.Name = "The trick"
        q.Position.X = 5: q.Position.Y = 15
        q.Value = 12345: q.Money = 3.14
     
        z.Name = "Visual Basic 6.0"
        z.Position.X = 99: z.Position.Y = 105
        z.Value = 7643: z.Money = 36.6
     
        GetMem4 VarPtr(q), ByVal VarPtr(nu) - 4    ' Set pointer to q (Pointer = &q)
     
        PrintRec Pointer
     
        GetMem4 VarPtr(z), ByVal VarPtr(nu) - 4    ' Set pointer to z (Pointer = &z)
     
        PrintRec Pointer
     
    EndFunction
     
    PrivateSub PrintRec(Pt As TestRec)
        Debug.Print"----------------"
        Debug.Print"Name = "& Pt.Name
        Debug.Print"Value = "& Pt.Value
        Debug.Print"Money = "& Pt.Money
        Debug.Print"Position.X = "& Pt.Position.X
        Debug.Print"Position.Y = "& Pt.Position.Y
    EndSub
    You can also create a pointer by using arrays. The idea is to create 2 arrays one element each, which will store the address of a variable, and the other will refer to the data. The first will always be Long, a second type of data desired. This is useful for example if you want to pass on lists, etc. It's no secret that the array in VB is simply an SafeArray. In the data structure of this array contains a lot of useful information, and a pointer to the data. What we do, we create two arrays:


    • 1st (with address) refers to a pointer to the second data array. As a result, changing the values in the first array, 2nd automatically refer to the desired data.*
    • 2nd is directly the data pointed to by the first.*


    Also, after all the manipulations necessary to return all the pointers back to VB properly clear the memory.* For all manipulations I created auxiliary functions and structure for data recovery.* Address SafeArray is available through Not Not Arr, but IDE after such manipulations are glitches with floating point:
    Code:

    PublicType PtDat
        Prv1 AsLong
        Prv2 AsLong
    EndType
     
    ' Create the pointer. 1st param is pointer, 2nd address.
    PublicFunction PtGet(Pointer() AsLong, ByVal VarAddr AsLong) As PtDat
    Dim i AsLong
        i = GetSA(ArrPtr(Pointer)) + &HC
        GetMem4 ByVal i, PtGet.Prv1
        GetMem4 VarAddr + &HC, ByVal i
        PtGet.Prv2 = Pointer(0)
    EndFunction
    ' Release pointer
    PublicSub PtRelease(Pointer() AsLong, prev As PtDat)
        Pointer(0) = prev.Prv2
        GetMem4 prev.Prv1, ByVal GetSA(ArrPtr(Pointer)) + &HC
    EndSub
    ' Obtaint address of SafeArray (same Not Not)
    PublicFunction GetSA(ByVal addr AsLong) AsLong
        GetMem4 ByVal addr, GetSA
    EndFunction
    Example of use:
    Code:

    PrivateSub Form_Load()
    Dim pt() AsLong, var() As TestRec, prev As PtDat      ' Pointer, references data, release data.
    Dim q As TestRec, z As TestRec                          ' The structures, which we refer
     
    ReDim pt(0): ReDim var(0)
     
        q.Name = "The trick"
        q.Position.X = 5: q.Position.Y = 15
        q.Value = 12345: q.Money = 3.14
     
        z.Name = "Visual Basic 6.0"
        z.Position.X = 99: z.Position.Y = 105
        z.Value = 7643: z.Money = 36.6
     
        prev = PtGet(pt, GetSA(ArrPtr(var)))                    ' Create "pointer"
     
        pt(0) = VarPtr(q)                                      ' Refer to q (pt = &q)
        PrintRec var(0)
        pt(0) = VarPtr(z)                                      ' Refer to z (pt = &z)
        PrintRec var(0)
     
        PtRelease pt, prev                                      ' Release
     
    EndSub

    Source:
    http://earlier189.rssing.com/browser.php?indx=6373759&item=376

    ↧
    ↧

    String-style operations by wrapping a Byte array

    February 17, 2021, 7:31 am
    $
    0
    0

    People seem to get tangled up in their underwear a lot trying to fiddle with binary data in String variables. Often they run into nightmares where they convert Unicode "to Unicode" and then back later, in the vain hope of avoiding data corruption. And then some locale boundary gets crossed and it all falls down. Hard.

    From what I've seen the bulk of this comes from the desire to use String operations on binary data. But most of these are fairly trivial to synthesize, especially with the help of CopyMemory.

    The Bytarr Class wraps a dynamic Byte array along with several properties and methods to make this easier.

    You can use the Class for lots of applications, or when you only need one or two operations it can server as a template for inline code when you don't want the Class.

    Bytarr (biter?) is bundled with a test program in the attachment. This also includes my Dump Class, which I find handy for debugging and testing.



    Source:
    ↧

    How to insert machine code in source code: VB6 & ASM

    March 30, 2021, 1:32 pm
    $
    0
    0
    Just a quick post for documentation sake of using inline asm with VB6 (or at least as close as we can get to it without an external c dll. In terms of development of the asm to put in. You can use your C Compiler to generate it for you..here are the tips.

    • CallwindowsProc has 5 arguments max and can return a long The first argument is already used so your args start at [EBP+0x0C] this means use a dummy int arg first in your prototype to line up args.
    • do not use any sub functions from your code do things in blocks in you have to.
    • once you generate your code, you can extract the opcodes from VC in debug mode viewing mixed mode disasm (develop as an exe usually although you may have to as a dll to use with vb as standard call dll).
    • you need to strip all the function prolog and epilog asm from the compiler generated block (or use naked declspec) your ret should be RETN 10h.
    • keep a couple nops (&H90) in place at start in case you need room to add a breakpoint (&hCC) manually to stop on your asm in a debugger to debug it. yes you will have to use ollydbg to debug it in asm most likley.
    • you can twiddle with the CallWindowProc prototypes more based on what you are using it for..see last example.
    Full example here:


    Note: All single quotes for comments are stripped by my blog script. Same as default CallWindowProc except param 1 is now "ByRef lpBytes As Any" or you can use the default like this: CallWindowProc(Varptr(asmBytes(0)).


    The most simple and direct example of VB6 & ASM:

    Private Declare Function CallAsm Lib "user32"
        Alias "CallWindowProcA"_
    (ByRef lpBytes As Any,
    ByVal hWnd AsLong,
    ByVal Msg AsLong,
    ByVal wParam AsLong,
    ByVal lParam AsLong)AsLong

    Function Shl(x AsLong)AsLong
    '8B45 0C        MOV EAX,DWORD PTR SS:[EBP+12]
    'D1E0           SHL EAX,1
    'C2 10 00       RETN 10h
    Dim o()AsByte
    Const sl AsString="8B 45 0C D1 E0 C2 10 00"
        o()= toBytes(sl)
        Shl = CallAsm(o(0), x,0,0,0)
    EndFunction

    privateFunction toBytes(x AsString)AsByte()
    Dim tmp()AsString
    Dim fx()AsByte
    Dim i AsLong

        tmp = Split(x,"")
    ReDim fx(UBound(tmp))

    For i =0ToUBound(tmp)
            fx(i)=CInt("&h"& tmp(i))
    Next

        toBytes = fx()

    EndFunction

    Another example of working on a byte buffer in your asm:

    Private Declare Function CallAsm2 Lib "user32"
         Alias "CallWindowProcA"_
    (ByRef lpBytes As Any,
         ByRef chararray As Any,
    ByVal length AsLong,
    ByVal unused1 AsLong,
    ByVal unused2 AsLong)AsLong




    Const opcodes AsString=
    "909090C745F800000000EB098B4DF88"&_
    "3C101894DF88B55F83B55107D258B45"&_
    "0C0345F88A08884DFC8B45F833D28A5"&_
    "5FC2AD08855FC8B550C0355F88A45FC"&_
    "8802EBCA9090C21000"

    fx()= toBytes2(opcodes)
    CallAsm2 fx(0), byteBufferToWorkOn(0),UBound(byteBufferToWorkOn),0,0

    Function toBytes2(x AsString, Optional debugit AsBoolean=False)AsByte()
    Dim tmp()AsString
    Dim fx()AsByte
    Dim i AsLong
    Dim y

    ReDim fx(Len(x)/2)

    For i =1ToLen(x) Step 2
            fx(y)=CByte(CLng("&h"&Mid(x, i,2)))
            y = y +1
    Next

    If debugit Then fx(0)=&HCC

        toBytes2 = fx()

    EndFunction

    The opcodes are for the following C with the prolog and epilog stripped out:

    void__stdcall  fnDecode(int dummy,char* b,int len)
    {
    char x;
    for(int i=0; i<len; i++){
            x = b[i];
    _asm{
    //do stuff to x here
    }
            b[i]= x;//update vb byte buffer
    }
    }

    Source:
    http://sandsprite.com/blogs/index.php/index.php?uid=11&pid=43

    ↧

    Calculating hashes: MD2, MD4, MD5, SHA1, SHA2-256, SHA2-384, and SHA2-512

    March 31, 2021, 8:50 am
    $
    0
    0
    It works with MD2, MD4, MD5, SHA1, SHA2-256, SHA2-384, and SHA2-512. Put the below code in a module (BAS file). It does everything that CAPICOM does regarding hashes, but without using any ActiveX DLL files. It depends entirely on the standard cryptographic API DLL files, using declare statements. There are several publicly accessible functions. These are
    HashBytes
    HashStringA
    HashStringU
    HashArbitraryData
    BytesToHex
    BytesToB64

    HashBytes computes a hash of a 1D byte array, who's lower bound is 0.

    HashStringA computes the hash of an Ascii/Ansi (1 byte per character) string. As VB6 strings are actually Unicode (2 bytes per character), and due to the fact that this function is intended to calculate the hash of the Ascii version of the string, the function first converts VB6's unicode characters to true Ascii characters via VB6's StrConv function. However, because characters with an Ascii value above 127 will differ between locales, the LocaleID is needed to be known for this conversion. As such, LocaleID is a parameter for this function. By default, the LocaleID used by the program is the LocaleID of the PC that the program is running on. This should be used in most situations, as this will generate a hash that will match the output of most other programs that generate a hash (such as the program called Easy Hash).

    HashStringU computes the hash of a Unicode (2 bytes per character) string. As VB6 strings are actually Unicode, there is no conversion needed, and thus is no need to specify LocaleID. Therefore, this function doesn't have a LocaleID parameter. Because each character is defined by 2 bytes, rather than 1, the output of this hash function will obviously differ from the hash calculated by HashStringA, and thus will differ from the hash calculated by most other hash calculating programs (such as the freeware one that I used for testing called Easy Hash). For example, a string with 3 spaces "" is represented as the byte array (shown in hex) 20 00 20 00 20 00 in Unicode encoding, but as 20 20 20 in Ascii encoding. These are 2 distinctly different byte arrays, and thus will produce 2 completely different hashes.
    Side-Note regarding Unicode in VB6: Despite this fact, that internally in VB6 all the strings are Unicode, the implementation of Unicode in VB6 is VERY LIMITED. That is, it won't display any Unicode character that can't also be displayed as an extended ascii character for the computer's current locale. Instead it will show it as a question mark. This won't effect how this function works (or the above function, as it's computing a hash, not displaying anything), but it will effect whether or not a given string will be properly displayed.

    HashArbitraryData computes the hash of absolutely anything. It just needs to know where in memory the first byte of data is, and how many bytes long the data is. It will work with multidimensional byte arrays, arrays of other data types, arrays that start with with a lower bound other than zero, user defined types, sections of memory allocated with API functions, etc. There's nothing that it can't compute the hash of. Of course this gives you the added responsibility of needing to know where exactly in memory the data is, and the size of the data in bytes.

    BytesToHex. This is a function intended to convert the raw bytes output from a hash function to a displayable hexadecimal string.

    BytesToB64. This is a function intended to convert the raw bytes output from a hash function to a displayable base64 string.

    Code:

    PrivateDeclareSub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length AsLong)
     
    PrivateDeclareFunction CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv AsLong, ByVal pszContainer AsString, ByVal pszProvider AsString, ByVal dwProvType AsLong, ByVal dwFlags AsLong) AsLong
    PrivateDeclareFunction CryptCreateHash Lib "advapi32.dll" (ByVal hProv AsLong, ByVal Algid AsLong, ByVal hKey AsLong, ByVal dwFlags AsLong, ByRef phHash AsLong) AsLong
    PrivateDeclareFunction CryptHashData Lib "advapi32.dll" (ByVal hHash AsLong, ByRef pbData As Any, ByVal dwDataLen AsLong, ByVal dwFlags AsLong) AsLong
    PrivateDeclareFunction CryptGetHashParam Lib "advapi32.dll" (ByVal hHash AsLong, ByVal dwParam AsLong, ByRef pByte As Any, ByRef pdwDataLen AsLong, ByVal dwFlags AsLong) AsLong
    PrivateDeclareFunction CryptDestroyHash Lib "advapi32.dll" (ByVal hHash AsLong) AsLong
    PrivateDeclareFunction CryptReleaseContext Lib "advapi32.dll" (ByVal hProv AsLong, ByVal dwFlags AsLong) AsLong
    PrivateDeclareFunction CryptBinaryToString Lib "Crypt32.dll" Alias "CryptBinaryToStringA" (ByRef pbBinary As Any, ByVal cbBinary AsLong, ByVal dwFlags AsLong, ByVal pszString AsString, ByRef pcchString AsLong) AsLong
     
    Private Const PROV_RSA_AES AsLong = 24
    Private Const CRYPT_VERIFYCONTEXT AsLong = &HF0000000
     
    PublicEnum HashAlgo
        HALG_MD2 = &H8001&
        HALG_MD4 = &H8002&
        HALG_MD5 = &H8003&
        HALG_SHA1 = &H8004&
        HALG_SHA2_256 = &H800C&
        HALG_SHA2_384 = &H800D&
        HALG_SHA2_512 = &H800E&
    EndEnum
     
    Private Const HP_HASHSIZE AsLong = &H4&
    Private Const HP_HASHVAL AsLong = &H2&
     
     
    PublicFunction HashBytes(ByRef Data() AsByte, OptionalByVal HashAlgorithm As HashAlgo = HALG_MD5) AsByte()
    Dim hProv AsLong
    Dim hHash AsLong
    Dim Hash() AsByte
    Dim HashSize AsLong
     
    CryptAcquireContext hProv, vbNullString, vbNullString, 24, CRYPT_VERIFYCONTEXT
    CryptCreateHash hProv, HashAlgorithm, 0, 0, hHash
    CryptHashData hHash, Data(0), UBound(Data) + 1, 0
    CryptGetHashParam hHash, HP_HASHSIZE, HashSize, 4, 0
    ReDim Hash(HashSize - 1)
    CryptGetHashParam hHash, HP_HASHVAL, Hash(0), HashSize, 0
    CryptDestroyHash hHash
    CryptReleaseContext hProv, 0
     
    HashBytes = Hash()
    EndFunction
     
     
     
    PublicFunction HashStringA(ByVal Text AsString, OptionalByVal LocaleID AsLong, OptionalByVal HashAlgorithm As HashAlgo = HALG_MD5) AsByte()
    Dim Data() AsByte
    Data() = StrConv(Text, vbFromUnicode, LocaleID)
    HashStringA = HashBytes(Data, HashAlgorithm)
    EndFunction
     
    PublicFunction HashStringU(ByVal Text AsString, OptionalByVal HashAlgorithm As HashAlgo = HALG_MD5) AsByte()
    Dim Data() AsByte
    Data() = Text
    HashStringU = HashBytes(Data, HashAlgorithm)
    EndFunction
     
    PublicFunction HashArbitraryData(ByVal MemAddress AsLong, ByVal ByteCount AsLong, OptionalByVal HashAlgorithm As HashAlgo = HALG_MD5) AsByte()
    Dim Data() AsByte
    ReDim Data(ByteCount - 1)
    CopyMemory Data(0), ByVal MemAddress, ByteCount
    HashArbitraryData = HashBytes(Data, HashAlgorithm)
    EndFunction
     
     
     
     
    PublicFunction BytesToHex(ByRef Bytes() AsByte) AsString
    Dim HexStringLen AsLong
    Dim HexString AsString
     
    CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 12, vbNullString, HexStringLen
    HexString = String$(HexStringLen, vbNullChar)
    CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 12, HexString, HexStringLen
     
    BytesToHex = UCase$(HexString)
    EndFunction
     
    PublicFunction BytesToB64(ByRef Bytes() AsByte) AsString
    Dim B64StringLen AsLong
    Dim B64String AsString
     
    CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 1, vbNullString, B64StringLen
    B64String = String$(B64StringLen, vbNullChar)
    CryptBinaryToString Bytes(0), UBound(Bytes) + 1, 1, B64String, B64StringLen
     
    BytesToB64 = B64String
    EndFunction

    Source:
    http://earlier189.rssing.com/browser.php?indx=6373759&item=379

    ↧
    Search

    Tempest Test for Windows

    April 1, 2021, 9:11 am
    $
    0
    0

    First a bit of background on the subject:
    Tempest is the concept of being able to retrieve usable information about what data is being processed by a computer or other electronic device, entirely from the "electronic noise" that is given off by that device. These RF emissions usually cause trouble if they cause interference with radio receivers like an AM radio that you are trying to listen to. The FCC has standards for reducing this interference to an acceptable level, but even so, if you are TRYING to pick up this signal it is usually possible.

    Screen:



    Under the right conditions, this interference isn't just unintelligible noise, but can actually convey data that is being processed by the computer at that time. This can cause a privacy risk if the data being processed that causes these RF emissions contains information is confidential. This could be the case if for example you are looking at a document on your PC that has confidential information, but your monitor's RF emissions allow the screen image to be received by an adversary with a radio receiver.

    To demonstrate the ability of a monitor to transmit intelligible information, Erik Thiele created a program called "Tempest for Eliza" (which you can read about here http://www.erikyyy.de/tempest/) which transmits Beethoven's song Fur Elise. It depends on the ability of a CRT monitor to send one pixel at a time to the screen with an electron gun, so that the signal going to the electron gun gets radiated as RF. So to send a tone, the brightness of a pixel is based on both the frequency of the audible tone and the RF frequency that you want to have to tune your AM radio to to receive it.

    Unfortunately, this program has several problems. One is that it requires being compiled (no binaries can be downloaded). Another is that it only runs on Linux. And lastly, it is based on a CRT monitor which sends one pixel at a time. The last of these is a problem because modern LCD monitors process data one line at a time. While vertically, each line of the display is set in sequence, within each line, all of the pixels are set simultaneously. There is no "pixel clock" in an LCD monitor, just a line clock and a data clock. The data clock runs very fast like a CPU processor (probably at 10s or 100s of megahertz at least) and handles the image data very fast for that particular line. Depending on the monitor's microcontroller clock speed (which can be pretty much anything, and not predictable like the pixel clock of a CRT monitor), you will have the carrierwave signal based on that clock speed. Depending on what that frequency is, you may need to tune around your radio to find it or one of its harmonics (sometimes these can be lower than the clock frequency in the form of a lower side band). There's not much than can be done about this, except tune your AM radio (preferably a shortwave receiver so you get more frequencies to search through) to the strongest signal for your particular LCD monitor. However, since you don't need to worry about the pixels horizontally, that means that every pixel on a given line can be lit up at maximum brightness, and I have found that this actually makes the signal stronger. You only need to worry about modulating the brightness vertically.

    And here's the solution I've found:
    Of course, there's a pretty simple solution to fixing these things at once. To fix the first 2 things, just write your own version of this software in a language you are familiar with and which is designed to compile for Windows (VB6 in this case). And the last thing is to make it so that every pixel is lit up on a given line, which naturally is easy to do when you are writing it yourself (you just write it to do that). So below, there are 2 links to my VB6 version of this guy's program, designed from the ground up to work with LCD monitors (sorry if you want to use it with a CRT monitor, it won't work, as I've made this based on the fact that nearly everyone uses LCD not CRT monitors nowadays). The first link fixes problem 2 and 3 (it is made for Windows, not Linux, and it is optimized for LCD screens, but still requires compiling). The second link fixes all 3 problems. It has the source code, just as with the first link, but it also has a compiled EXE file (in case you don't want to go through the hassle of compiling it yourself, or if you don't have a copy of VB6 yourself). If you are really paranoid about viruses and stuff, you can use the first link, but as it is not a virus (I have no desire to hack anybody's PC) I would highly recommend the second link, which has all the source code (just as with the first link) and also has the compiled EXE file.

    The name of the program is "Tempest Test for Windows". With it, you can determine how much RF signal is coming from your monitor that actually conveys information about what's on your computer screen, with the idea that if you are running a business that has confidential info on your computer, and you find that you can hear the music from this program playing on a nearby radio, you should consider Faraday shielding your PC or the room that the PC is in. As with the original "Tempest for Eliza" (which was created by Erik Thiele), it plays Fur Elise. The notes data are in the "song.txt" file, which can be edited to make it play any musical piece that you want.



    Controls:
    There's only one control, the Esc key. Press it to close the program before the song has finished playing. If the song is allowed to continue playing, the program will close when the song ends.

    Format of the "song.txt" file:
    It is case-insensitive. Each note is specified by note letter, a modifier symbol ("#" for sharp, or "b" for flat, and yes that is a lowercase "B", but uppercase works as well, as the program is completely case insensitive), and an octave number (from 0 to 8), in that order. In the case of it not being sharp or flat, you leave out the modifier. For example, D sharp in octave 4 is D#4 (or d#4), while B normal in octave 7 is B7 (or b7), and B flat in octave 2 is Bb2 (or bb2, or bB2, or BB2). Each note or special symbol is separated from each other by a space. There are 2 special symbols ("." and "-"). The "." represents no tone transmitted for the period of one half of a note. The dash represents holding the previous note for a period of one note. Any other text in a given entry, or a blank entry (such as formed by an extra space at the start or end of the text file, or by 2 consecutive spaces in the middle of the file) will trigger the error "Stop statement encountered". This is because I left a stop statement in it while debugging it, prior to compiling it. That stopped the code is designed to stop it so that you can check one of the variables that holds the string for that note or special symbol, to see why it didn't match what the program was expecting (so you could go search for the specific bad string in the song.txt file and correct it). It's not nearly as useful with the EXE file, as it alerts you to the fact that there is something wrong with the file, but you'll need to manually look through the text file to see what's wrong. But I left it in anyway so that you could see if there is in fact something wrong with the text file, should you decide to edit it and put in your own song.

    Code:

    PrivateDeclareSub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length AsLong, ByVal Fill AsByte)
    PrivateDeclareFunction SetDIBits Lib "gdi32.dll" (ByVal hDC AsLong, ByVal hBitmap AsLong, ByVal nStartScan AsLong, ByVal nNumScans AsLong, ByRef lpBits As Any, ByRef lpBI As BITMAPINFO, ByVal wUsage AsLong) AsLong
    PrivateDeclareSub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds AsLong)
    PrivateDeclareFunction SetWindowPos Lib "user32.dll" (ByVal hWnd AsLong, ByVal hWndInsertAfter AsLong, ByVal x AsLong, ByVal y AsLong, ByVal cx AsLong, ByVal cy AsLong, ByVal wFlags AsLong) AsLong
    PrivateDeclareFunction GetAsyncKeyState Lib "user32.dll" (ByVal vKey AsLong) AsInteger
     
     
    PrivateType BITMAPINFOHEADER
        biSize AsLong
        biWidth AsLong
        biHeight AsLong
        biPlanes AsInteger
        biBitCount AsInteger
        biCompression AsLong
        biSizeImage AsLong
        biXPelsPerMeter AsLong
        biYPelsPerMeter AsLong
        biClrUsed AsLong
        biClrImportant AsLong
    EndType
     
    PrivateType RGBQUAD
        rgbBlue AsByte
        rgbGreen AsByte
        rgbRed AsByte
        rgbReserved AsByte
    EndType
     
    PrivateType BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors(255) As RGBQUAD
    EndType
     
     
    Dim PicW AsLong
    Dim PicH AsLong
    Dim Pix() AsByte
    Dim BMI As BITMAPINFO
     
    PrivateType Note
        Freqency AsSingle
        Duration AsLong
    EndType
     
    Dim Song() As Note
     
    Dim ProgQuit AsBoolean
     
    PrivateSub Form_Activate()
    Dim y AsLong
    Dim n AsLong
    Dim z AsByte
    Dim Freq AsSingle
    Dim FrameRate AsLong
    Dim FrameDuration AsSingle
    Dim LineDuration AsSingle
    Dim LineRate AsSingle
     
    FrameRate = 60
    FrameDuration = 1 / FrameRate
    LineDuration = FrameDuration / PicH
    LineRate = 1 / LineDuration
     
    SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, &H201
     
    For n = 0 ToUBound(Song)
        Freq = Song(n).Freqency
    For y = 0 To PicH - 1
            FillMemory Pix(0, y), PicW, Sgn(Sin(2 * 3.14159 * Freq * y / LineRate)) * 127.5 + 127.5
    Next y
        SetDIBits Me.hDC, Me.Image.Handle, 0, PicH, Pix(0, 0), BMI, 0
        Refresh
        Sleep Song(n).Duration
    DoEvents
    If ProgQuit ThenExitSub
    Next n
    Unload Me
    EndSub
     
    PrivateSub Form_Load()
    Dim i AsLong
    Dim NotesStr AsString
     
    ChDir App.Path
     
    PicW = Screen.Width / 15
    PicH = Screen.Height / 15
    ReDim Pix(PicW - 1, PicH - 1)
    With BMI
    With .bmiHeader
            .biSize = 40
            .biPlanes = 1
            .biBitCount = 8
            .biClrUsed = 256
            .biClrImportant = 256
            .biWidth = PicW
            .biHeight = -PicH
    EndWith
    For i = 0 To 255
    With .bmiColors(i)
                .rgbRed = i
                .rgbGreen = i
                .rgbBlue = i
    EndWith
    Next i
    EndWith
     
    Open"song.txt"ForBinary Access Read As #1
    NotesStr = String$(LOF(1), vbNullChar)
    Get #1, 1, NotesStr
    Close #1
     
    Song() = String2Notes(NotesStr, 300)
     
    GetAsyncKeyState vbKeyEscape
    Timer1.Enabled = True
    EndSub
     
     
    PrivateFunction String2Notes(ByVal NotesStr AsString, ByVal Duration AsLong) As Note()
    Dim NoteStrings() AsString
    Dim Notes() As Note
    Dim n AsLong
     
    NoteStrings() = Split(NotesStr, "")
    ReDim Notes(UBound(NoteStrings))
    For n = 0 ToUBound(Notes)
    With Notes(n)
    SelectCase NoteStrings(n)
    Case"."
                    .Freqency = 0
                    .Duration = Duration / 2
    Case"-"
                    .Freqency = Notes(n - 1).Freqency
                    .Duration = Duration
    CaseElse
                    .Freqency = Note2Freq(NoteStrings(n))
                    .Duration = Duration
    EndSelect
    EndWith
    Next n
    String2Notes = Notes()
    EndFunction
     
    PrivateFunction Note2Freq(ByVal NoteName AsString) AsSingle
    SelectCase LCase$(NoteName)
    Case"c0"
            Note2Freq = 16.35
    Case"c#0", "db0"
            Note2Freq = 17.32
    Case"d0"
            Note2Freq = 18.35
    Case"d#0", "eb0"
            Note2Freq = 19.45
    Case"e0"
            Note2Freq = 20.6
    Case"f0"
            Note2Freq = 21.83
    Case"f#0", "gb0"
            Note2Freq = 23.12
    Case"g0"
            Note2Freq = 24.5
    Case"g#0", "ab0"
            Note2Freq = 25.96
    Case"a0"
            Note2Freq = 27.5
    Case"a#0", "bb0"
            Note2Freq = 29.14
    Case"b0"
            Note2Freq = 30.87
     
    Case"c1"
            Note2Freq = 32.7
    Case"c#1", "db1"
            Note2Freq = 34.65
    Case"d1"
            Note2Freq = 36.71
    Case"d#1", "eb1"
            Note2Freq = 38.89
    Case"e1"
            Note2Freq = 41.2
    Case"f1"
            Note2Freq = 43.65
    Case"f#1", "gb1"
            Note2Freq = 46.25
    Case"g1"
            Note2Freq = 49
    Case"g#1", "ab1"
            Note2Freq = 51.91
    Case"a1"
            Note2Freq = 55
    Case"a#1", "bb1"
            Note2Freq = 58.27
    Case"b1"
            Note2Freq = 61.74
     
    Case"c2"
            Note2Freq = 65.41
    Case"c#2", "db2"
            Note2Freq = 69.3
    Case"d2"
            Note2Freq = 73.42
    Case"d#2", "eb2"
            Note2Freq = 77.78
    Case"e2"
            Note2Freq = 82.41
    Case"f2"
            Note2Freq = 87.31
    Case"f#2", "gb2"
            Note2Freq = 92.5
    Case"g2"
            Note2Freq = 98
    Case"g#2", "ab2"
            Note2Freq = 103.83
    Case"a2"
            Note2Freq = 110
    Case"a#2", "bb2"
            Note2Freq = 116.54
    Case"b2"
            Note2Freq = 123.47
     
    Case"c3"
            Note2Freq = 130.81
    Case"c#3", "db3"
            Note2Freq = 138.59
    Case"d3"
            Note2Freq = 146.83
    Case"d#3", "eb3"
            Note2Freq = 155.56
    Case"e3"
            Note2Freq = 164.81
    Case"f3"
            Note2Freq = 174.61
    Case"f#3", "gb3"
            Note2Freq = 185
    Case"g3"
            Note2Freq = 196
    Case"g#3", "ab3"
            Note2Freq = 207.65
    Case"a3"
            Note2Freq = 220
    Case"a#3", "bb3"
            Note2Freq = 233.08
    Case"b3"
            Note2Freq = 246.94
     
    Case"c4"
            Note2Freq = 261.63
    Case"c#4", "db4"
            Note2Freq = 277.18
    Case"d4"
            Note2Freq = 293.66
    Case"d#4", "eb4"
            Note2Freq = 311.13
    Case"e4"
            Note2Freq = 329.63
    Case"f4"
            Note2Freq = 349.23
    Case"f#4", "gb4"
            Note2Freq = 369.99
    Case"g4"
            Note2Freq = 392
    Case"g#4", "ab4"
            Note2Freq = 415.3
    Case"a4"
            Note2Freq = 440
    Case"a#4", "bb4"
            Note2Freq = 466.16
    Case"b4"
            Note2Freq = 493.88
     
    Case"c5"
            Note2Freq = 523.25
    Case"c#5", "db5"
            Note2Freq = 554.37
    Case"d5"
            Note2Freq = 587.33
    Case"d#5", "eb5"
            Note2Freq = 622.25
    Case"e5"
            Note2Freq = 659.25
    Case"f5"
            Note2Freq = 698.46
    Case"f#5", "gb5"
            Note2Freq = 739.99
    Case"g5"
            Note2Freq = 783.99
    Case"g#5", "ab5"
            Note2Freq = 830.61
    Case"a5"
            Note2Freq = 880
    Case"a#5", "bb5"
            Note2Freq = 932.33
    Case"b5"
            Note2Freq = 987.77
     
    Case"c6"
            Note2Freq = 1046.5
    Case"c#6", "db6"
            Note2Freq = 1108.73
    Case"d6"
            Note2Freq = 1174.66
    Case"d#6", "eb6"
            Note2Freq = 1244.51
    Case"e6"
            Note2Freq = 1318.51
    Case"f6"
            Note2Freq = 1396.91
    Case"f#6", "gb6"
            Note2Freq = 1479.98
    Case"g6"
            Note2Freq = 1567.98
    Case"g#6", "ab6"
            Note2Freq = 1661.22
    Case"a6"
            Note2Freq = 1760
    Case"a#6", "bb6"
            Note2Freq = 1864.66
    Case"b6"
            Note2Freq = 1975.53
     
    Case"c7"
            Note2Freq = 2093
    Case"c#7", "db7"
            Note2Freq = 2217.46
    Case"d7"
            Note2Freq = 2349.32
    Case"d#7", "eb7"
            Note2Freq = 2489.02
    Case"e7"
            Note2Freq = 2637.02
    Case"f7"
            Note2Freq = 2793.83
    Case"f#7", "gb7"
            Note2Freq = 2959.96
    Case"g7"
            Note2Freq = 3135.96
    Case"g#7", "ab7"
            Note2Freq = 3322.44
    Case"a7"
            Note2Freq = 3520
    Case"a#7", "bb7"
            Note2Freq = 3729.31
    Case"b7"
            Note2Freq = 3951.07
     
    Case"c8"
            Note2Freq = 4186.01
    Case"c#8", "db8"
            Note2Freq = 4434.92
    Case"d8"
            Note2Freq = 4698.63
    Case"d#8", "eb8"
            Note2Freq = 4978.03
    Case"e8"
            Note2Freq = 5274.04
    Case"f8"
            Note2Freq = 5587.65
    Case"f#8", "gb8"
            Note2Freq = 5919.91
    Case"g8"
            Note2Freq = 6271.93
    Case"g#8", "ab8"
            Note2Freq = 6644.88
    Case"a8"
            Note2Freq = 7040
    Case"a#8", "bb8"
            Note2Freq = 7458.62
    Case"b8"
            Note2Freq = 7902.13
     
    CaseElse
    Stop
    EndSelect
    EndFunction
     
     
    PrivateSub Timer1_Timer()
    If (GetAsyncKeyState(vbKeyEscape) And 1) = 1 Then
        ProgQuit = True
        Unload Me
    EndIf
    EndSub


    ↧
    ↧

    Gigabyte file read/write: Binary I/O on very large disk files

    June 9, 2021, 2:55 pm
    $
    0
    0

    Download from ME

    Option Explicit
    '
    'HugeBinaryFile
    '==============
    '
    'A class for doing simple binary I/O on very large disk files
    '(well over the usual 2GB limit).  It only does I/O using Byte
    'arrays, and makes use of Currency values that are scaled to
    'whole numbers in places:
    '
    '   For a file of one byte the FileLen property returns 1.0000 as
    '   its value.
    '
    'Operation is similar in many ways to native VB Get#/Put# I/O, for
    'example the EOF property must be checked after a ReadBytes() call.
    'You must also Dim/Redim buffers to desired sizes before calling
    'ReadBytes() or WriteBytes().
    '
    'Short (signed Long) relative seeks and long (unsigned Currency)
    'absolute seeks from 0 may be done.
    '
    'AutoFlush may be set True to force buffer flushes on every write.
    'The Flush() method may be called explicitly if necessary.
    '

    Public Enum HBF_Errors
      HBF_UNKNOWN_ERROR =45600
      HBF_FILE_ALREADY_OPEN
      HBF_OPEN_FAILURE
      HBF_SEEK_FAILURE
      HBF_FILELEN_FAILURE
      HBF_READ_FAILURE
      HBF_WRITE_FAILURE
      HBF_FILE_ALREADY_CLOSED
    End Enum

    PrivateConst HBF_SOURCE ="HugeBinaryFile"

    PrivateConst GENERIC_WRITE AsLong=&H40000000
    PrivateConst GENERIC_READ AsLong=&H80000000
    PrivateConst FILE_ATTRIBUTE_NORMAL AsLong=&H80&
    PrivateConst CREATE_ALWAYS =2
    PrivateConst OPEN_ALWAYS =4
    PrivateConst INVALID_HANDLE_VALUE =-1
    PrivateConst INVALID_SET_FILE_POINTER =-1
    PrivateConst INVALID_FILE_SIZE =-1

    PrivateConst FILE_BEGIN =0, FILE_CURRENT =1, FILE_END =2

    Private Type MungeCurr
        Value AsCurrency
    End Type

    Private Type Munge2Long
        LowVal AsLong
        HighVal AsLong
    End Type

    Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA"(_
    ByVal dwFlags AsLong,_
        lpSource AsLong,_
    ByVal dwMessageId AsLong,_
    ByVal dwLanguageId AsLong,_
    ByVal lpBuffer AsString,_
    ByVal nSize AsLong,_
        Arguments As Any)AsLong

    Private Declare Function ReadFile Lib "kernel32"(_
    ByVal hFile AsLong,_
        lpBuffer As Any,_
    ByVal nNumberOfBytesToRead AsLong,_
        lpNumberOfBytesRead AsLong,_
    ByVal lpOverlapped AsLong)AsLong

    Private Declare Function CloseHandle Lib "kernel32"(_
    ByVal hObject AsLong)AsLong

    Private Declare Function GetFileSize Lib "kernel32"(_
    ByVal hFile AsLong,_
        lpFileSizeHigh AsLong)AsLong

    Private Declare Function WriteFile Lib "kernel32"(_
    ByVal hFile AsLong,_
        lpBuffer As Any,_
    ByVal nNumberOfBytesToWrite AsLong,_
        lpNumberOfBytesWritten AsLong,_
    ByVal lpOverlapped AsLong)AsLong

    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA"(_
    ByVal lpFileName AsString,_
    ByVal dwDesiredAccess AsLong,_
    ByVal dwShareMode AsLong,_
    ByVal lpSecurityAttributes AsLong,_
    ByVal dwCreationDisposition AsLong,_
    ByVal dwFlagsAndAttributes AsLong,_
    ByVal hTemplateFile AsLong)AsLong

    Private Declare Function SetFilePointer Lib "kernel32"(_
    ByVal hFile AsLong,_
    ByVal lDistanceToMove AsLong,_
        lpDistanceToMoveHigh AsLong,_
    ByVal dwMoveMethod AsLong)AsLong

    Private Declare Function FlushFileBuffers Lib "kernel32"(_
    ByVal hFile AsLong)AsLong

    Private hFile AsLong
    Private sFName AsString
    Private fAutoFlush AsBoolean
    Private fEOF AsBoolean
    Private C As MungeCurr
    Private L As Munge2Long

    PublicPropertyGet AutoFlush()AsBoolean
        RaiseErrorIfClosed
        AutoFlush = fAutoFlush
    EndProperty

    PublicPropertyLet AutoFlush(ByVal NewVal AsBoolean)
        RaiseErrorIfClosed
        fAutoFlush = NewVal
    EndProperty

    PublicPropertyGet FileHandle()AsLong
        RaiseErrorIfClosed
        FileHandle = hFile
    EndProperty

    PublicPropertyGetFileLen()AsCurrency
        RaiseErrorIfClosed
        L.LowVal = GetFileSize(hFile, L.HighVal)
    If L.LowVal = INVALID_FILE_SIZE Then
    IfErr.LastDllError Then RaiseError HBF_FILELEN_FAILURE
    EndIf
    LSet C = L
    FileLen= C.Value *10000@
    EndProperty

    PublicPropertyGet FileName()AsString
        RaiseErrorIfClosed
        FileName = sFName
    EndProperty

    PublicPropertyGetEOF()AsBoolean
        RaiseErrorIfClosed
    EOF= fEOF
    EndProperty

    PublicPropertyGet IsOpen()AsBoolean
        IsOpen = hFile <> INVALID_HANDLE_VALUE
    EndProperty

    PublicSub CloseFile()
        RaiseErrorIfClosed
        CloseHandle hFile
        sFName =""
        fAutoFlush =False
        fEOF =False
        hFile = INVALID_HANDLE_VALUE
    EndSub

    PublicSub Flush()
        RaiseErrorIfClosed
        FlushFileBuffers hFile
    EndSub

    PublicSub OpenFile(ByVal OpenFileName AsString)
    If hFile <> INVALID_HANDLE_VALUE Then
            RaiseError HBF_FILE_ALREADY_OPEN
    EndIf
        hFile = CreateFile(OpenFileName, GENERIC_WRITE Or GENERIC_READ,0,_
    0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL,0)
    If hFile = INVALID_HANDLE_VALUE Then
            RaiseError HBF_OPEN_FAILURE
    EndIf
        sFName = OpenFileName
    EndSub

    PublicFunction ReadBytes(ByRef Buffer()AsByte)AsLong
        RaiseErrorIfClosed
    If ReadFile(hFile,_
                    Buffer(LBound(Buffer)),_
    UBound(Buffer)-LBound(Buffer)+1,_
                    ReadBytes,_
    0)Then
    If ReadBytes =0Then
                fEOF =True
    EndIf
    Else
            RaiseError HBF_READ_FAILURE
    EndIf
    EndFunction

    PublicSub SeekAbsolute(ByVal Position AsCurrency)
        RaiseErrorIfClosed
        C.Value = Position /10000@
    LSet L = C
    If SetFilePointer(hFile, L.LowVal, L.HighVal, FILE_BEGIN)_
    = INVALID_SET_FILE_POINTER Then
    IfErr.LastDllError Then RaiseError HBF_SEEK_FAILURE
    EndIf
    EndSub

    PublicSub SeekEnd()
        RaiseErrorIfClosed
    If SetFilePointer(hFile,0&,ByVal0&, FILE_END)_
    = INVALID_SET_FILE_POINTER Then
                RaiseError HBF_SEEK_FAILURE
    EndIf
    EndSub

    PublicSub SeekRelative(ByVal Offset AsLong)
    'Offset is signed.
        RaiseErrorIfClosed
    If SetFilePointer(hFile, Offset,ByVal0&, FILE_CURRENT)_
    = INVALID_SET_FILE_POINTER Then
                RaiseError HBF_SEEK_FAILURE
    EndIf
    EndSub

    PublicFunction WriteBytes(Buffer()AsByte)AsLong
        RaiseErrorIfClosed
    If WriteFile(hFile,_
                     Buffer(LBound(Buffer)),_
    UBound(Buffer)-LBound(Buffer)+1,_
                     WriteBytes,_
    0)Then
    If fAutoFlush Then Flush
    Else
            RaiseError HBF_WRITE_FAILURE
    EndIf
    EndFunction

    PrivateSub Class_Initialize()
        hFile = INVALID_HANDLE_VALUE
    EndSub

    PrivateSub Class_Terminate()
    If hFile <> INVALID_HANDLE_VALUE Then CloseHandle hFile
    EndSub

    PrivateSub RaiseError(ByVal ErrorCode As HBF_Errors)
    Dim Win32Err AsLong, Win32Text AsString

        Win32Err =Err.LastDllError
    If Win32Err Then
            Win32Text = vbNewLine &"Error "& Win32Err & vbNewLine _
    & DecodeAPIErrors(Win32Err)
    EndIf
    If IsOpen Then CloseFile
    SelectCase ErrorCode
    Case HBF_FILE_ALREADY_OPEN
    Err.Raise HBF_FILE_ALREADY_OPEN, HBF_SOURCE,_
    "File already open."
    Case HBF_OPEN_FAILURE
    Err.Raise HBF_OPEN_FAILURE, HBF_SOURCE,_
    "Error opening file."& Win32Text
    Case HBF_SEEK_FAILURE
    Err.Raise HBF_SEEK_FAILURE, HBF_SOURCE,_
    "Seek Error."& Win32Text
    Case HBF_FILELEN_FAILURE
    Err.Raise HBF_FILELEN_FAILURE, HBF_SOURCE,_
    "GetFileSize Error."& Win32Text
    Case HBF_READ_FAILURE
    Err.Raise HBF_READ_FAILURE, HBF_SOURCE,_
    "Read failure."& Win32Text
    Case HBF_WRITE_FAILURE
    Err.Raise HBF_WRITE_FAILURE, HBF_SOURCE,_
    "Write failure."& Win32Text
    Case HBF_FILE_ALREADY_CLOSED
    Err.Raise HBF_FILE_ALREADY_CLOSED, HBF_SOURCE,_
    "File must be open for this operation."
    CaseElse
    Err.Raise HBF_UNKNOWN_ERROR, HBF_SOURCE,_
    "Unknown error."& Win32Text
    EndSelect
    EndSub

    PrivateSub RaiseErrorIfClosed()
    If hFile = INVALID_HANDLE_VALUE Then RaiseError HBF_FILE_ALREADY_CLOSED
    EndSub

    PrivateFunction DecodeAPIErrors(ByVal ErrorCode AsLong)AsString
    Const FORMAT_MESSAGE_FROM_SYSTEM AsLong=&H1000&
    Dim strMsg AsString, lngMsgLen AsLong

        strMsg =Space$(256)
        lngMsgLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,0&,_
                                  ErrorCode,0&, strMsg,256&,0&)
    If lngMsgLen >0Then
            DecodeAPIErrors =Left(strMsg, lngMsgLen)
    Else
            DecodeAPIErrors ="Unknown Error."
    EndIf
    EndFunction


    Option Explicit
    '
    'Timer-driven demo of HugeBinaryFile class.
    '

    Private hbfFile As HugeBinaryFile
    Private blnWriting AsBoolean
    Private bytBuf(1To1000000)AsByte
    Private lngBlocks AsLong
    PrivateConst MAX_BLOCKS AsLong=5000

    PrivateSub cmdRead_Click()
        cmdWrite.Enabled =False
        cmdRead.Enabled =False
        lngBlocks =0
        lblRead.Caption =""
        blnWriting =False
    Set hbfFile =New HugeBinaryFile
        hbfFile.OpenFile "test.dat"
        lblStatus =" Reading "_
    &Format$(hbfFile.FileLen,"##,###,###,###,##0")_
    &" bytes"
        Timer1.Enabled =True
    EndSub

    PrivateSub cmdWrite_Click()
        cmdWrite.Enabled =False
        cmdRead.Enabled =False
    OnErrorResumeNext
    Kill"test.dat"
    OnErrorGoTo0
        lngBlocks =0
        lblWritten.Caption =""
        lblStatus =" Writing "_
    &Format$(CCur(MAX_BLOCKS)*CCur(UBound(bytBuf)),"##,###,###,###,##0")_
    &" bytes"
        blnWriting =True
    Set hbfFile =New HugeBinaryFile
        hbfFile.OpenFile "test.dat"
        Timer1.Enabled =True
    EndSub

    PrivateSub Form_Unload(Cancel AsInteger)
    IfNot(hbfFile Is Nothing)Then
    If hbfFile.IsOpen Then hbfFile.CloseFile
    Set hbfFile =Nothing
    EndIf
    EndSub

    PrivateSub Timer1_Timer()
    If blnWriting Then
            hbfFile.WriteBytes bytBuf
            lngBlocks = lngBlocks +1
            lblWritten.Caption =_
    Format$(CCur(lngBlocks)*CCur(UBound(bytBuf)),"##,###,###,###,##0")_
    &" bytes written"
    If lngBlocks >= MAX_BLOCKS Then
                Timer1.Enabled =False
                hbfFile.CloseFile
    Set hbfFile =Nothing
                lblStatus =""
                cmdWrite.Enabled =True
                cmdRead.Enabled =True
    EndIf
    Else
            hbfFile.ReadBytes bytBuf
    If hbfFile.EOFThen
                Timer1.Enabled =False
                hbfFile.CloseFile
    Set hbfFile =Nothing
                lblStatus =""
                cmdWrite.Enabled =True
                cmdRead.Enabled =True
    Else
                lngBlocks = lngBlocks +1
                lblRead.Caption =_
    Format$(CCur(lngBlocks)*CCur(UBound(bytBuf)),"##,###,###,###,##0")_
    &" bytes read"
    EndIf
    EndIf
    EndSub

    ↧

    Russian 3D Jet simulator in Visual Basic 6.0

    June 30, 2021, 5:58 pm
    $
    0
    0
    Links on VBForums start to disappear in time as they are replaced with more and more complex implementations in VB6. What I do here is to preserve what Mikle uploaded on Yandex. If you wish to build a professional 3D game in VB6, with Mikle's implementations the sky's the limit !

    Download from ME










    ↧

    Digital Signal Processing (VB6)

    July 15, 2021, 9:05 am
    $
    0
    0
    Visual Basic 6.0 - Preview:
    '======================================================================
    ' Descrizione.....: Collezione di routines e costanti di utilita'
    '                   per il Digital Signal Processing.

    '======================================================================
    '
    '   Le routines di questo modulo sono un sotto insieme
    '   di quelle contenute nel progetto FiltCalc (sito dei
    '   DownLoads) e sono state modificate per adattarle a
    '   questa applicazione.
    '   Non tutte le costanti e le routines di questo
    '   modulo vengono, necessariamente, usate.
    '
    OptionExplicit
    '
    '--- Windows ----------------------------------------------------------
    PublicTypeWindow_Type'
    NomeAsString' Nome della "Window":
    PMinAsDouble' Valore Min. del Parametro associato.
    PMaxAsDouble' Valore Max. del Parametro associato.
    PCorAsDouble' Valore corrente del Parametro associato.
    EndType
    '
    PrivateConstA0#=0.99938' Coefficienti per la
    PrivateConstA1#=0.041186' Weber Window.
    PrivateConstA2#=-1.637363'
    PrivateConstA3#=0.828217'
    PrivateConstB0#=1.496611'
    PrivateConstB1#=-1.701521'
    PrivateConstB2#=0.372793'
    PrivateConstB3#=0.0650621'
    '
    '--- Spettro mobile (sliding spectrum) -------------------------------------------------
    '   Implementazione dei circuiti tratti da:
    '"Theory and Application of Digital Signal Processing"
    '    di L. Rabiner e B. Gold. - pg. 382, 383.
    '
    PrivateNsSpm&' N° di campioni per il calcolo dello spettro mobile.
    PrivateNormSpm#' Fattore di normalizzazione sul N° di campioni.
    '
    ' Coefficienti per il calcolo con convoluzione diretta:
    Privatez1()AsComplex'  vettore dei coefficienti di calcolo dello spettro mobile.
    PrivateSmRE#()'  registro a scorrimento dei campioni del segnale.
    '
    ' Coefficienti per il calcolo  ricorsivo:
    PrivateSn_1AsComplex'  Sn * Z^-1.
    Privatez1_1AsComplex'  z1(0)^-1
    Privatez1_NAsComplex'  z1(0)^-N
    PrivateIc&,Kc&'  indici in SmRE() per buffer circolare.
    PrivateNsSpm1&'  NsSpm + 1.
    PrivateXz1_NAsComplex'  variabili di appoggio.
    PrivateYz1_1AsComplex'"""
    PrivateSnIAsComplex'"""
    PrivateSnAsComplex'"""
    '
    ' Per multi frequenza:
    PrivateNFreqSPM_1&' N° di frequenze - 1 a cui calcolare gli spettri.
    ' Coefficienti per il calcolo ricorsivo multi frequenza:
    PrivateSn_MF_1()AsComplex'  vettore degli (NFreqSPM_1 + 1) Sn * Z^-1
    Privatez1_MF_1()AsComplex'  z1()^-1
    Privatez1_MF_N()AsComplex'  z1()^-N
    '
    PrivateSqRE#()' Registro a scorrimento dei campioni del segnale al quadrato.
    PrivateVMed#' Valore medio corrente.
    '
    '--- Filtri FIR ------------------------------------------------------------------------
    '   Algoritmi tradotti ed adattati dal FORTRAN di:
    '"Digital Filters and their Applications"
    '     di V. Cappellini, A. G. Constantinides, P. Emiliani.
    '     Window method:  pg. 350.
    '
    PrivateHc!()' Vettore dei coefficienti del filtro.
    '
    PrivateWF#()' Tabella dei coefficienti per Windowing.
    '
    PrivateSRE!()' Registro a scorrimento dei Dati da Filtrare.
    '
    PrivateConstFiltroErrFIR$="Le Routines di calcolo hanno trovato"&vbNewLine_
    &"una condizione imprevista."&vbNewLine_
    &"Provare a rivedere i parametri del filtro."&vbNewLine&vbNewLine
    '
    '--- Filtri IIR ------------------------------------------------------------------------
    '   Gli algoritmi per la sintesi di filtri del tipo Butterworth
    '   e Chebyshev sono stati tradotti ed adattati dal FORTRAN di:
    '"Digital Filters and their Applications"
    '     di V. Cappellini, A. G. Constantinides, P. Emiliani.
    '     pg. 367, 368, 369.
    '   Metodi di calcolo dei filtri elementari.
    '   - Algoritmi di trasformazione da "Digital Signal Processing"
    '     di W. D. Stanley - pg. 172, 173, 174.
    '   - La funzione di trasferimento del risuonatore reale parallelo
    '     e' tratta da "Teoria delle Reti Elettriche", Appunti dai
    '     corsi del Politecnico di Torino - pg. (1.3)1 e seg.
    '   - L' idea della sostituzione degli zeri per il "Notch Filter"
    '     proviene da: http://www-users.cs.york.ac.uk/~fisher/mkfilter/res.html
    '
    PrivateNK&,NCel&' Ordine e numero di sezioni del filtro.
    PrivateAc!()' Coefficienti del filtro.
    PrivateBc!()'"""
    '
    PrivateConstNCMax&=20' N. Massimo di sezioni del filtro.                                                                         ¦
    '
    Privatew!()' Registri delle sezioni del filtro.
    '
    PrivateCEB#(1To2*NCMax+1)' Vettori in uso durante la sintesi.
    PrivateAN#(0To4,0To2)'""""
    PrivateFINA#(0To2)'""""
    PrivateFINB#(0To2)'""""
    '
    PrivateConstFiltroErrIIR$="Le Routines di calcolo hanno trovato"&vbNewLine_
    &"una condizione imprevista."&vbNewLine_
    &"Provare a rivedere i parametri del filtro."&vbNewLine&vbNewLine
    '
    '--- Per routines SFFTBI e SFTTBF ------------------------------------------------------
    PrivateMM&' integer such that N = 2**MM
    PrivateS1#()' array of sin() table (length >= n/8-1)
    PrivateC1#()' array of cos() table (length >= n/8-1)
    PrivateS3#()' array of sin() table (length >= n/8-1)
    PrivateC3#()' array of cos() table (length >= n/8-1)
    PrivateITAB&()' integer bit reversal table (length >= sqrt(2n))
    PrivateD1#()' Vettore dei dati di ingresso a base 1, come richiesto dal FORTRAN.
    '
    '--- Per auto e mutua correlazione con SFFTBI_Corr, SFTTBF_Corr e SFFTBB_Corr ----------
    PrivateN1_C&' N° di valori in D1().
    PrivateN2_C&' N° di valori in D2().
    PrivateMM_C&' MM_C = Ceil(Log(CDbl(N1_C + N2_C - 1)) / Log2)
    PrivateN_C&' N_C =  2**MM_C
    PrivateS1_C#()' array of sin() table (length >= N_C/8-1)
    PrivateC1_C#()' array of cos() table (length >= N_C/8-1)
    PrivateS3_C#()' array of sin() table (length >= N_C/8-1)
    PrivateC3_C#()' array of cos() table (length >= N_C/8-1)
    PrivateITAB_C&()' integer bit reversal table (length >= sqrt(2*N_C))
    PrivateD1_C#()' Vettore dei dati di ingresso a base 1, come richiesto dal FORTRAN.
    PrivateNFre_C&' N° di frequenze calcolate.
    PrivateWnRe#()' Tavole dei seni/coseni per il calcolo della trasformata del
    PrivateWnIm#()' segnale ritardato di N1_C campioni (solo per AutoCorr_FT).
    PrivateRe1_C#()' Parte reale       della 1° trasformata.
    PrivateIm1_C#()'"   immaginaria   """
    PrivateRe2_C#()' Parte reale       della 2° trasformata.
    PrivateIm2_C#()'"   immaginaria   """
    Privates#(),f#()' Vettori d' appoggio.
    '
    '--- API di gestione memoria: ----------------------------------------------------------
    PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"_
    (hpvDestAsAny,hpvSourceAsAny,ByValnumBytesAsLong)
    '
    PrivateDeclareSubMoveMemoryLib"kernel32"Alias"RtlMoveMemory"_
    (hpvDestAsAny,hpvSourceAsAny,ByValnumBytesAsLong)
    '
    PrivateDeclareSubZeroMemoryLib"kernel32"Alias"RtlZeroMemory"_
    (hpvDestAsAny,ByValnumBytesAsLong)
    PublicFunctionEliminaCC(d()AsDouble,OptionalByRefVMedAsDouble)AsDouble()
    '
    '   Ritorna i dati del vettore D(0 To N) dopo l' eliminazione
    '   della componente continua. I dati risultanti avranno, quindi,
    '   valor medio = 0.  Ritorna anche VMed, valor medio dei dati in D().
    '
    DimI&,N&,dd#()
    '
    dd()=d()
    N=UBound(dd)
    VMed=0#
    '
    ForI=0ToN
    VMed=VMed+dd(I)
    NextI
    VMed=VMed/(N+1)
    '
    ForI=0ToN
    dd(I)=dd(I)-VMed
    NextI
    '
    EliminaCC=dd()
    '
    '
    '
    EndFunction
    PublicFunctionSPM(ByValXn!)AsSingle
    '
    '   Funzione per il calcolo con convoluzione diretta dello
    '   spettro mobile (sliding spectrum) su NsSpm campioni.
    '   Devono essere stati definiti, precedentemente, il vettore
    '   dei coefficienti Z1() ed un vettore SmRE(0 To NsSpm - 1) da
    '   usare come registro a scorrimento dei campioni del segnale.
    '
    DimK&
    '
    ForK=NsSpm-1To1Step-1
    SmRE(K)=SmRE(K-1)
    NextK
    SmRE(0)=CDbl(Xn)
    '
    Sn=CCmp(SmRE(0),0#)
    ForK=1ToNsSpm-1
    Sn=CSom(Sn,CMol(CCmp(SmRE(K),0#),z1(K)))
    NextK
    '
    SPM=CSng(CAbs(Sn))/CDbl(NsSpm)
    '
    '
    '
    EndFunction
    PublicSubSPM_Init(ByValNsSpm_IAsLong,ByValFreqAsDouble,ByValFsAsDouble)
    '
    '   Calcolo dei coefficienti necessari alla
    '   implementazione con convoluzione diretta
    '   dello spettro mobile su NsSpm campioni:
    '
    DimI&,OmegaT#
    '
    NsSpm=NsSpm_I' N° di campioni per il calcolo dello spettro mobile.
    NormSpm=CDbl(NsSpm)/2#' Fattore di normalizzazione sul N° di campioni.
    '
    ReDimz1(0ToNsSpm)' Vettore dei coefficienti di calcolo con
    ' convoluzione diretta dello spettro mobile;
    ' z1(0) = e^j*omega*T.
    ReDimSmRE#(0ToNsSpm)' Registro a scorrimento dei campioni del segnale.
    '
    OmegaT=PI2*Freq/Fs' Per frequenza in [Hz].
    'OmegaT = PI2 * Freq         ' Per frequenza in [f/fs].
    z1(0)=CExp(CCmp(0#,OmegaT))
    '
    ' Per calcolo con convoluzione diretta:
    ForI=1ToNsSpm-1
    z1(I)=CPtN(z1(0),-I)
    NextI
    '
    '
    '
    EndSub
    PublicSubSPM_R_Init(ByValNsSpm_IAsLong,ByValFreqAsDouble,ByValFs_IAsDouble)
    '
    '   Calcolo dei coefficienti necessari alla
    '   implementazione ricorsiva dello spettro
    '   mobile su NsSpm campioni:
    '
    DimI&,OmegaT#
    '
    NsSpm=NsSpm_I' N° di campioni per il calcolo dello spettro mobile.
    NsSpm1=NsSpm+1
    NormSpm=CDbl(NsSpm)/2#' Fattore di normalizzazione sul N° di campioni.
    '
    ReDimz1(0To0)' z1(0) = e^j*omega*T.
    ReDimSmRE#(0ToNsSpm)' Registro a scorrimento dei campioni del segnale.
    '
    OmegaT=PI2*Freq/Fs_I' Per frequenza in [Hz].
    'OmegaT = PI2 * Freq         ' Per frequenza in [f/fs].
    z1(0)=CExp(CCmp(0#,OmegaT))
    '
    ' Per calcolo ricorsivo:
    Sn_1=CCmp(0#,0#)
    z1_1=CPtN(z1(0),-1)
    z1_N=CPtN(z1(0),-NsSpm)
    '
    '
    '
    EndSub
    PublicSubSPM_MF_R_Init(ByValNsSpm_IAsLong,ByValNFREAsLong,Freq()AsDouble,_
    ByValFsAsDouble)
    '
    '   Calcolo dei coefficienti necessari alla
    '   implementazione ricorsiva, multi frequenza
    '   dello spettro mobile su NsSpm campioni.
    '   Le frequenze, a cui calcolare gli spettri,
    '   devono essere definite nel vettore Freq(0 to NFreqSPM_1):
    '
    DimI&,OmegaT#
    '
    NsSpm=NsSpm_I' N° di campioni per il calcolo dello spettro mobile.
    NsSpm1=NsSpm+1
    NFreqSPM_1=NFRE-1' N° di frequenze - 1 a cui calcolare gli spettri.
    NormSpm=CDbl(NsSpm)/2#' Fattore di normalizzazione sul N° di campioni.
    '
    ReDimz1(0To0)' z1(0) = e^j*omega*T.
    ReDimSmRE(0ToNsSpm)' Registro a scorrimento dei campioni del segnale.
    ReDimSqRE(0ToNsSpm)' Registro a scorrimento dei campioni del segnale al quadrato.
    VMed=0#' Valore medio corrente.
    '
    ReDimSn_MF_1(0ToNFreqSPM_1)
    ReDimz1_MF_1(0ToNFreqSPM_1)
    ReDimz1_MF_N(0ToNFreqSPM_1)
    '
    ForI=0ToNFreqSPM_1
    OmegaT=PI2*Freq(I)/Fs' Per frequenze in [Hz].
    'OmegaT = PI2 * Freq(I)         ' Per frequenze in [f/fs].
    z1(0)=CExp(CCmp(0#,OmegaT))
    '
    ' Per calcolo ricorsivo:
    Sn_MF_1(I)=CCmp(0#,0#)
    z1_MF_1(I)=CPtN(z1(0),-1)
    z1_MF_N(I)=CPtN(z1(0),-NsSpm)
    NextI
    '
    '
    '
    EndSub
    PublicSubSPM_MF_R(ByValIMedAsLong,ByValXnAsSingle,_
    ByRefSpmMF()AsDouble,ByRefMedMFAsDouble)
    '
    '   Routine per il calcolo ricorsivo dello spettro mobile (sliding
    '   spectrum) multi frequenza su NsSpm campioni.
    '   Devono essere stati definiti, precedentemente, i coefficienti
    '   z1_MF_1(), z1_MF_N() ed un vettore SmRE(0 To NsSpm) da usare come
    '   registro a scorrimento dei campioni del segnale.
    '   Ritorna anche il valore della media (o del valor efficace) mobile
    '   degli ultimi NsSpm campioni.
    '   In questa routine, per ragioni di velocita', le funzioni di numeri
    '   complessi sono state sostituite con il loro sviluppo in linea.
    '
    DimK&
    '
    OnErrorResumeNext' Gestisce gli errori di troncamento nel calcolo di MedMF.
    '
    ' SmRE() usato come buffer circolare:
    Ic=((Ic+1)ModNsSpm1)
    Kc=((Ic+1)ModNsSpm1)
    SmRE(Ic)=CDbl(Xn)
    '
    ForK=0ToNFreqSPM_1
    'XZ1_N = CMol(CCmp(SmRE(Kc), 0#), z1_MF_N)
    Xz1_N.Re=SmRE(Kc)*z1_MF_N(K).Re
    Xz1_N.Im=SmRE(Kc)*z1_MF_N(K).Im
    'SnI = CDif(CCmp(SmRE(Ic), 0#), XZ1_N)
    SnI.Re=SmRE(Ic)-Xz1_N.Re
    SnI.Im=-Xz1_N.Im
    '
    'YZ1_1 = CMol(Sn_MF_1(K), z1_MF_1(K))
    Yz1_1.Re=Sn_MF_1(K).Re*z1_MF_1(K).Re-Sn_MF_1(K).Im*z1_MF_1(K).Im
    Yz1_1.Im=Sn_MF_1(K).Re*z1_MF_1(K).Im+Sn_MF_1(K).Im*z1_MF_1(K).Re
    'Sn = CSom(SnI, YZ1_1)
    Sn.Re=SnI.Re+Yz1_1.Re
    Sn.Im=SnI.Im+Yz1_1.Im
    Sn_MF_1(K)=Sn
    '
    'SpmMF(K) = CAbs(Sn) / NormSpm
    SpmMF(K)=Sqr(Sn.Re*Sn.Re+Sn.Im*Sn.Im)/NormSpm
    NextK
    '
    ' Calcolo la media/valor efficace mobile:
    If(NsSpm<IMed)Then
    ' Media mobile del valore assoluto del segnale:
    'VMed = VMed + Abs(SmRE(Ic)) - Abs(SmRE(Kc))
    'MedMF = VMed / CDbl(NsSpm)
    '
    ' Valore efficace mobile:
    SqRE(Ic)=SmRE(Ic)*SmRE(Ic)
    VMed=VMed+SqRE(Ic)-SqRE(Kc)
    MedMF=Sqr(VMed/CDbl(NsSpm))
    '
    Else
    ' Gestisco l' inizio del segnale:
    If(IMed=1)ThenVMed=0#
    '
    ' Media mobile del valore assoluto del segnale:
    'VMed = VMed + Abs(SmRE(Ic))
    'MedMF = VMed / CDbl(IMed)
    '
    ' Valore efficace mobile:
    SqRE(Ic)=SmRE(Ic)*SmRE(Ic)
    VMed=VMed+SqRE(Ic)
    MedMF=Sqr(VMed/CDbl(IMed))
    EndIf
    '
    '
    '
    EndSub
    PublicFunctionSPM_R(ByValXnAsLong)AsLong
    'Public Function SPM_R(ByVal Xn As Single) As Single
    '
    '   Funzione per il calcolo ricorsivo dello spettro mobile
    '   (sliding spectrum) su NsSpm campioni.
    '   Devono essere stati definiti, precedentemente, i coefficienti
    '   Z1_1, Z1_N ed un vettore SmRE(0 To NsSpm) da usare come
    '   registro a scorrimento dei campioni del segnale.
    '   In questa routine, per ragioni di velocita', le funzioni di numeri
    '   complessi sono state sostituite con il loro sviluppo in linea.
    '
    '   Versione per filtro del trigger di AudioCardDSP (24/04/2009).
    '
    ' SmRE() usato come buffer circolare:
    Ic=((Ic+1)ModNsSpm1)
    Kc=((Ic+1)ModNsSpm1)
    SmRE(Ic)=Xn
    '
    ' XZ1_N = CMol(CCmp(SmRE(NsSpm), 0#), Z1_N):
    Xz1_N.Re=SmRE(Kc)*z1_N.Re
    Xz1_N.Im=SmRE(Kc)*z1_N.Im
    '
    ' SnI = CDif(CCmp(SmRE(0), 0#), XZ1_N):
    SnI.Re=SmRE(Ic)-Xz1_N.Re
    SnI.Im=-Xz1_N.Im
    '
    ' Yz1_1 = CMol(Sn_1, z1_1):
    Yz1_1.Re=Sn_1.Re*z1_1.Re-Sn_1.Im*z1_1.Im
    Yz1_1.Im=Sn_1.Re*z1_1.Im+Sn_1.Im*z1_1.Re
    '
    ' Sn = CSom(SnI, Yz1_1):
    Sn.Re=SnI.Re+Yz1_1.Re
    Sn.Im=SnI.Im+Yz1_1.Im
    Sn_1=Sn
    '
    ' SPM_R = CAbs(Sn) / NormSpm:
    SPM_R=Sqr(Sn.Re*Sn.Re+Sn.Im*Sn.Im)/NormSpm
    '
    '
    '
    EndFunction
    PublicFunctionMCorr_FT(D1()AsDouble,D2()AsDouble,_
    ByValR1AsLong,ByValR2AsLong,_
    OptionalByValbUnbiasedAsBoolean=False,_
    OptionalByValbNoCCAsBoolean=False)AsDouble()
    '
    '   Espressione della mutua correlazione non circolare:
    '   MCorr_FT(R) = (L / Ld) * IFFT((1 / L) * Coniugata(FFT(D1(I))) * FFT(D2(I)))
    '    con: N1  = UBound(D1),  N2 = UBound(D2),
    '        -N1 <= R1 <= 0,  0 <= R2 <= N2,  R1 <= R <= R2,
    '         L  = MIN(N1 + 1,  N2 + 1),  Ld = MIN(N1 + R, N2) - MAX(0, R) + 1
    '
    '   Ritorna un vettore contenente la funzione di mutua correlazione
    '   fra i dati in D1() e quelli in D2() calcolata su R1 --> R2  ritardi
    '   [i.e. MCorr_FT(R1 To R2)].
    '   I segnali D1() e D2() sono considerati finiti.
    '   Se bUnbiased = True i valori della mutua correlazione vengono
    '   corretti con 1 / (N - r).
    '   Se bNoCC = True dai segnali viene eliminata la componente continua.
    '
    '   Il calcolo viene effettuato con FFT e IFFT.
    '   Algoritmo tratto da: "Theory and Application of Digital
    '   Signal Processing" di L. Rabiner e B. Gold. - pg. 403
    '   e corretto con le equazioni di "Digital Time Series Analysis"
    '   di R. K. Otnes, L. Enochson. - pg. 247, 248.
    '
    '   Ver. 18/10/2005 modificata per AudioCardDSP.
    '
    DimM&,M2_1&,N1&,N2&,r&
    DimLNorm#,dd1#(),dd2#(),NBytes&
    DimRe1#(),Im1#(),Re2#(),Im2#(),s#(),f#()
    '
    N1=UBound(D1)
    N2=UBound(D2)
    '
    M=Ceil(Log((N1+N2+1))/Log2)
    M2_1=(2^M)-1
    '
    ' I dati devono avere media zero?
    IfbNoCCThen
    dd1()=EliminaCC(D1())
    dd2()=EliminaCC(D2())
    Else
    dd1()=D1()
    dd2()=D2()
    EndIf
    '
    ReDimPreservedd1(0ToM2_1)' Aggiungo zeri per avere una potenza di 2.
    ReDimPreservedd2(0ToM2_1)'""""""""
    ' Sposto i valori per comporre
    ' opportunamente il secondo segnale:
    MoveMemorydd2(N1+1),dd2(0),8*(N2+1)
    ZeroMemorydd2(0),8*(N1+1)
    '    For R = N2 To 0 Step -1
    '        dd2(N1 + R + 1) = dd2(R)
    '        dd2(R) = 0#
    '    Next R
    '
    ' Calcolo la FFT dei due segnali:
    FFT_D2dd1(),dd2(),Re1(),Im1(),Re2(),Im2(),M2_1+1
    '
    ' Moltiplico la seconda trasformata
    ' per la coniugata della prima:
    ReDims(0ToM2_1),f(0ToM2_1)' Uso S() e F() come vettori d' appoggio.
    Forr=0ToM2_1
    s(r)=(Re1(r)*Re2(r)+Im1(r)*Im2(r))' Parte reale.
    f(r)=(Re1(r)*Im2(r)-Re2(r)*Im1(r))' Parte immaginaria.
    Nextr
    '
    ' Calcolo l' antitrasformata, corrispondente
    ' alla funzione di mutua correlazione:
    IFFTs(),f(),Re1(),Im1()' Uso Re1() e Im1() come vettori d' appoggio.
    '
    ' Sistemo i valori nell' ordine dei ritardi:
    ReDimIm1(R1ToR2)' Uso Im1() come vettore d' appoggio.
    NBytes=8*(R2-R1+1)' I valori > N1 + N2 + 1 sono nulli e/o simmetrici.
    CopyMemoryIm1(R1),Re1(N1+R1+1),NBytes
    '    For R = R1 To R2
    '        Im1(R) = Re1(N1 + R + 1)
    '    Next R
    '
    IfbUnbiasedThen
    ' Correzione dei valori della mutua
    ' correlazione con 1 / (N - r):
    Forr=R1ToR2
    ' LNorm = MIN(N1 + R, N2) - MAX(0, R) + 1:
    If(N1+r<N2)Then
    LNorm=CDbl(N1+r+1)
    Else
    LNorm=CDbl(N2+1)
    EndIf
    If(0<r)ThenLNorm=LNorm-CDbl(r)
    '
    Im1(r)=Im1(r)/LNorm
    Nextr
    '
    Else
    ' Correzione dei valori della mutua
    ' correlazione con 1 / N:
    'LNorm = CDbl(MIN0(N1 + 1, N2 + 1))
    If(N1<=N2)Then
    LNorm=CDbl(N1+1)
    Else
    LNorm=CDbl(N2+1)
    EndIf
    Forr=R1ToR2
    Im1(r)=Im1(r)/LNorm
    Nextr
    EndIf
    '
    MCorr_FT=Im1()
    '
    '
    '
    EndFunction
    PublicFunctionMAutoCorr_FT(D1()AsDouble,_
    ByValR1AsLong,ByValR2AsLong,_
    OptionalByValbUnbiasedAsBoolean=True,_
    OptionalByValbNoCCAsBoolean=True)AsDouble()
    '
    '   Espressione dell' auto correlazione non circolare:
    '   MCorr_FT(R) = (L / Ld) * IFFT((1 / L) * Coniugata(FFT(D1(I))) * FFT(D1(I)))
    '
    '    con: D1(0 To N1_C - 1),
    '         MM_C = Ceil(Log(CDbl(2 * N1_C - 1)) / Log2),
    '         N_C = 2 ^ MM_C, NFre_C = N_C / 2,
    '        -N1_C < R1 <= 0,  0 <= R2 < N1_C,  R1 <= R <= R2,
    '         L  = N1_C,  Ld = N1_C - Abs(R)
    '
    '   Ritorna un vettore contenente la funzione di auto correlazione
    '   dei dati in D1() calcolata su R1 --> R2  ritardi [i.e. MAutoCorr_FT(R1 To R2)].
    '
    '   I segnali D1() sono considerati finiti.
    '   Se bUnbiased = True i valori dell' auto correlazione vengono
    '   corretti con 1 / (N - |r|).
    '   Se bNoCC = True dai segnali viene eliminata la componente continua.
    '
    '   Il calcolo viene effettuato con SFFTBF_Corr e SFFTBB_Corr e
    '   deve essere preceduto da una chiamata alla Sub SFFTBI_Corr.
    '
    '   Algoritmo tratto da: "Theory and Application of Digital
    '   Signal Processing" di L. Rabiner e B. Gold. - pg. 403
    '   e corretto con le equazioni di "Digital Time Series Analysis"
    '   di R. K. Otnes, L. Enochson. - pg. 247, 248.
    '
    '   Ver. 18/10/2005 modificata per AudioCardDSP.
    '   Ver. 22/05/2007 con SFFTBF_Corr e SFFTBB_Corr.
    '
    Dimr&,NBytes&
    Dimdd1#(),Sxx#
    DimCorr#(),LNorm#
    '
    ' I dati devono avere media zero?
    IfbNoCCThen
    dd1()=EliminaCC(D1())
    Else
    dd1()=D1()
    EndIf
    '
    ReDimPreservedd1(0ToN_C-1)' Aggiungo zeri per avere una potenza di 2.
    '
    ' Calcolo la FFT del segnale:
    SFFTBF_Corrdd1(),Re1_C(),Im1_C()
    '
    ' (A) - Calcolo la trasformata del segnale
    '       ritardato di N1_C campioni:
    'For R = 0 To NFre_C
    '    Re2_C(R) = (Re1_C(R) * WnRe(R) - Im1_C(R) * WnIm(R))    ' Parte reale.
    '    Im2_C(R) = (WnRe(R) * Im1_C(R) + Re1_C(R) * WnIm(R))    ' Parte immaginaria.
    'Next R
    '
    ' (B) - Moltiplico la seconda trasformata
    '       per la coniugata della prima:
    'For R = 0 To NFre_C
    '    S(R) = (Re1_C(R) * Re2_C(R) + Im1_C(R) * Im2_C(R))  ' Parte reale.
    '    F(R) = (Re1_C(R) * Im2_C(R) - Re2_C(R) * Im1_C(R))  ' Parte immaginaria.
    'Next R
    '
    ' Compatto i calcoli (A) e (B) precedenti per
    ' aumentarne la velocita' di esecuzione:
    Forr=0ToNFre_C
    Sxx=Re1_C(r)*Re1_C(r)+Im1_C(r)*Im1_C(r)
    s(r)=Sxx*WnRe(r)' Parte reale.
    f(r)=Sxx*WnIm(r)' Parte immaginaria.
    Nextr
    '
    ' Calcolo l' antitrasformata, corrispondente
    ' alla funzione di mutua correlazione:
    SFFTBB_Corrs(),f(),dd1()' Uso dd1() come vettore d' appoggio.
    '
    ' Sistemo i valori nell' ordine dei ritardi:
    ReDimCorr(R1ToR2)' Uso Corr() come vettore d' appoggio.
    NBytes=8*(R2-R1+1)' I valori > 2 * N1_C - 1 sono nulli e/o simmetrici.
    CopyMemoryCorr(R1),dd1(N1_C+R1),NBytes
    '
    IfbUnbiasedThen
    ' Correzione dei valori della mutua
    ' correlazione con 1 / (N - |r|):
    Forr=R1ToR2
    LNorm=CDbl(N1_C-Abs(r))
    Corr(r)=Corr(r)/LNorm
    Nextr
    '
    Else
    ' Correzione dei valori della mutua
    ' correlazione con 1 / N:
    LNorm=CDbl(N1_C)
    Forr=R1ToR2
    Corr(r)=Corr(r)/LNorm
    Nextr
    EndIf
    '
    MAutoCorr_FT=Corr()
    '
    '
    '
    EndFunction
    PublicFunctionMMutuaCorr_FT(D1()AsDouble,D2()AsDouble,_
    ByValR1AsLong,ByValR2AsLong,_
    OptionalByValbUnbiasedAsBoolean=False,_
    OptionalByValbNoCCAsBoolean=False)AsDouble()
    '
    '   Espressione della mutua correlazione non circolare:
    '   MMutuaCorr_FT(R) = (L / Ld) * IFFT((1 / L) * Coniugata(FFT(D1(I))) * FFT(D2(I)))
    '
    '    con: D1(0 To N1_C - 1), D2(0 To N2_C - 1),
    '         MM_C = Ceil(Log(CDbl(N1_C + N2_C - 1)) / Log2),
    '         N_C = 2 ^ MM_C, NFre_C = N_C / 2,
    '        -N1_C < R1 <= 0,  0 <= R2 < N2_C,  R1 <= R <= R2,
    '         L  = MIN(N1_C,  N2_C),  Ld = MIN(N1_C + R, N2_C) - MAX(0, R)
    '
    '   Ritorna un vettore contenente la funzione di mutua correlazione
    '   fra i dati in D1() e quelli in D2() calcolata su R1 --> R2  ritardi
    '   [i.e. MAutoCorr_FT(R1 To R2)].
    '
    '   I segnali D1() e D2() sono considerati finiti.
    '   Se bUnbiased = True i valori dell' auto correlazione vengono
    '   corretti con 1 / (N - |r|).
    '   Se bNoCC = True dai segnali viene eliminata la componente continua.
    '
    '   Il calcolo viene effettuato con SFFTBF_Corr e SFFTBB_Corr e
    '   deve essere preceduto da una chiamata alla Sub SFFTBI_Corr.
    '
    '   Algoritmo tratto da: "Theory and Application of Digital
    '   Signal Processing" di L. Rabiner e B. Gold. - pg. 403
    '   e corretto con le equazioni di "Digital Time Series Analysis"
    '   di R. K. Otnes, L. Enochson. - pg. 247, 248.
    '
    '   Ver. 18/10/2005 modificata per AudioCardDSP.
    '   Ver. 22/05/2007 con SFFTBF_Corr e SFFTBB_Corr.
    '
    '
    Dimr&,NBytes&
    Dimdd1#(),dd2#()
    DimCorr#(),LNorm#
    '
    ' I dati devono avere media zero?
    IfbNoCCThen
    dd1()=EliminaCC(D1())
    dd2()=EliminaCC(D2())
    Else
    dd1()=D1()
    dd2()=D2()
    EndIf
    '
    ReDimPreservedd1(0ToN_C-1)' Aggiungo zeri per avere una potenza di 2.
    ReDimPreservedd2(0ToN_C-1)' Aggiungo zeri per avere una potenza di 2.
    ' Sposto i valori per comporre
    ' opportunamente il secondo segnale
    ' ritardato di N1_C campioni:
    MoveMemorydd2(N1_C),dd2(0),8*N2_C
    ZeroMemorydd2(0),8*N1_C
    '
    ' Calcolo le FFT dei segnali:
    SFFTBF_Corrdd1(),Re1_C(),Im1_C()
    SFFTBF_Corrdd2(),Re2_C(),Im2_C()
    '
    ' Moltiplico la seconda trasformata
    ' per la coniugata della prima:
    Forr=0ToNFre_C
    s(r)=(Re1_C(r)*Re2_C(r)+Im1_C(r)*Im2_C(r))' Parte reale.
    f(r)=(Re1_C(r)*Im2_C(r)-Re2_C(r)*Im1_C(r))' Parte immaginaria.
    Nextr
    '
    ' Calcolo l' antitrasformata, corrispondente
    ' alla funzione di mutua correlazione:
    SFFTBB_Corrs(),f(),dd1()' Uso dd1() come vettore d' appoggio.
    '
    ' Sistemo i valori nell' ordine dei ritardi:
    ReDimCorr(R1ToR2)' Uso Corr() come vettore d' appoggio.
    NBytes=8*(R2-R1+1)' I valori > N1_C + N2_C - 1 sono nulli e/o simmetrici.
    CopyMemoryCorr(R1),dd1(N1_C+R1),NBytes
    '
    IfbUnbiasedThen
    ' Correzione dei valori della mutua
    ' correlazione con 1 / (N - |r|):
    Forr=R1ToR2
    ' LNorm = MIN0(N1_C + R, N2_C) - MAX0(0, R):
    If(N1_C+r<N2_C)Then
    LNorm=CDbl(N1_C+r)
    Else
    LNorm=CDbl(N2_C)
    EndIf
    If(0<r)ThenLNorm=LNorm-CDbl(r)
    '
    Corr(r)=Corr(r)/LNorm
    Nextr
    '
    Else
    ' Correzione dei valori della mutua
    ' correlazione con 1 / N:
    ' LNorm = CDbl(MIN0(N1_C, N2_C)):
    If(N1_C<=N2_C)Then
    LNorm=CDbl(N1_C)
    Else
    LNorm=CDbl(N2_C)
    EndIf
    '
    Forr=R1ToR2
    Corr(r)=Corr(r)/LNorm
    Nextr
    EndIf
    '
    MMutuaCorr_FT=Corr()
    '
    '
    '
    EndFunction
    PublicSubFFT_D2(D1()AsDouble,D2()AsDouble,_
    R1()AsDouble,X1()AsDouble,R2()AsDouble,X2()AsDouble,ByRefNVALAsLong)
    '
    '   Definizioni:
    '
    '   FFT = Fast Fourier Transform.
    '
    '   Entra con:
    '       D1()  = Vettore dei dati Reali del primo   Segnale(t).
    '       D2()  = Vettore dei dati Reali del secondo Segnale(t).
    '       NVAL  = Numero max. dei dati in D1(), D2() da usare.
    '
    '   Esce  con:
    '       R1()  = Vettore dei valori Reali      della Trasformata(f) del primo   segnale.
    '       X1()  = Vettore dei valori Immaginari della Trasformata(f) del primo   segnale.
    '       R2()  = Vettore dei valori Reali      della Trasformata(f) del secondo segnale.
    '       X2()  = Vettore dei valori Immaginari della Trasformata(f) del secondo segnale.
    '       NVAL  = Numero  dei dati usati        dalla Trasformata(f).
    '       NFRE  = Numero  dei valori di Frequenza calcolati.
    '
    '   Calcola, contemporaneamente, le trasformate di due segnali
    '   reali definiti in D1(0 To NVAL - 1) e D2(0 To NVAL - 1).
    '
    '   I valori delle Trasformate in R1(), X1(), R2(), X2() NON vengono
    '   normalizzati sulla lunghezza del Segnale 2^M.
    '
    '   I vettori R1(), X1() e R2(), X2() sono dimensionati in questa routine.
    '   Gli NN dati nei vettori sono organizzati come Vettore(0 To NN - 1).
    '
    '   Tradotta in Basic da: "Theory and Application of Digital
    '"Theory and Application of Digital Signal Processing"
    '    di L. Rabiner e B. Gold. - pg. 367.
    '   e con le formule di:
    '"Digital Time Series Analysis"
    '    di R. Otnes e L. Enochson - pg. 175.
    '
    '   Ver. 18/10/2005 modificata per AudioCardDSP.
    '
    DimM&,I&,NMN1&,NFRE&,J&,K&,L&,LE&,LE1&,IP&,JF&,NBytes&
    DimTSwap#,Ur#,Ui#,wr#,wi#,Tr#,Ti#
    '
    M=Int(Log(CDbl(NVAL)+0.5)/Log2)
    NVAL=2^M
    NFRE=NVAL/2
    NMN1=NVAL-1
    '
    ReDimRe#(0ToNVAL-1),Im#(0ToNVAL-1)
    ReDimR1(0ToNVAL-1),R2(0ToNVAL-1),X1(0ToNVAL-1),X2(0ToNVAL-1)
    '
    ' Compongo i vettori Re(), Im() da trasformare
    ' con i dati reali in ingresso:
    NBytes=8*NVAL
    CopyMemoryRe(0),D1(0),NBytes
    CopyMemoryIm(0),D2(0),NBytes
    '    For I = 0 To NVAL - 1
    '        Re(I) = D1(I)
    '        Im(I) = D2(I)
    '    Next I
    '
    J=0
    ForI=0ToNMN1-1
    If(I<J)Then
    ' DSWAP Re(J), Re(I):
    TSwap=Re(J)
    Re(J)=Re(I)
    Re(I)=TSwap
    ' DSWAP Im(J), Im(I)
    TSwap=Im(J)
    Im(J)=Im(I)
    Im(I)=TSwap
    EndIf
    K=NFRE
    DoWhile(K-1<J)
    J=J-K
    K=K/2
    Loop
    J=J+K
    NextI
    '
    ForL=1ToM
    LE=2^L
    LE1=LE/2
    Ur=1#
    Ui=0#
    wr=Cos(PI/LE1)
    wi=Sin(PI/LE1)
    ForJ=0ToLE1-1
    ForI=JToNVAL-1StepLE
    IP=I+LE1
    Tr=Re(IP)*Ur-Im(IP)*Ui
    Ti=Re(IP)*Ui+Im(IP)*Ur
    Re(IP)=Re(I)-Tr
    Im(IP)=Im(I)-Ti
    Re(I)=Re(I)+Tr
    Im(I)=Im(I)+Ti
    NextI
    Tr=Ur
    Ti=Ui
    Ur=Tr*wr-Ti*wi
    Ui=Tr*wi+Ti*wr
    NextJ
    NextL
    '
    ' Calcolo delle parti reali ed immaginarie delle trasformate:
    R1(0)=Re(0)
    X1(0)=0#
    R2(0)=Im(0)
    X2(0)=0#
    '
    ForJF=1ToNVAL-1
    R1(JF)=(Re(JF)+Re(NVAL-JF))/2#
    X1(JF)=(Im(JF)-Im(NVAL-JF))/2#
    R2(JF)=(Im(JF)+Im(NVAL-JF))/2#
    X2(JF)=(Re(NVAL-JF)-Re(JF))/2#
    NextJF
    '
    '
    '
    EndSub
    PublicSubIFFT(r()AsDouble,X()AsDouble,Dr()AsDouble,dx()AsDouble,_
    OptionalByRefNVALAsLong)
    '
    '   Definizioni:
    '
    '   IFFT = Inverse Fast Fourier Transform.
    '
    '   Entra con:
    '       R()  = Vettore dei valori Reali      della Trasformata(f).
    '       X()  = Vettore dei valori Immaginari della Trasformata(f).
    '
    '   Esce  con:
    '       Dr() = Vettore dei dati Reali      del Segnale(t).
    '       Dx() = Vettore dei dati Immaginari del Segnale(t).
    '       NVAL = Numero  dei dati usati per l' antitrasformata.
    '
    '   I vettori Dr(), Dx() sono dimensionati in questa routine.
    '   Gli NN dati nei vettori sono organizzati come Vettore(0 To NN - 1).
    '
    '   Algoritmo tratto da: "Theory and Application of Digital
    '   Signal Processing" di L. Rabiner e B. Gold. - pg. 371.
    '
    DimNFRE&,M&,I&,NMN1&,J&
    DimK&,L&,LE&,LE1&,IP&,JF&
    DimUr#,Ui#,wr#,wi#,Tr#,Ti#
    '
    NVAL=UBound(r)+1
    M=Int(Log(CDbl(NVAL)+0.5)/Log2)
    NVAL=2^M
    NFRE=NVAL/2
    NMN1=NVAL-1
    '
    ReDimDr(0ToNVAL-1),dx(0ToNVAL-1),d(0ToNVAL-1)
    '
    ' Se non si vogliono sfruttare le proprieta'
    '"transform-in-place" di questa implementazione:
    ForI=0ToNVAL-1
    Dr(I)=r(I)/CDbl(NVAL)
    dx(I)=-X(I)/CDbl(NVAL)
    NextI
    '
    J=0
    ForI=0ToNMN1-1
    If(I<J)Then
    DSWAPDr(J),Dr(I)
    DSWAPdx(J),dx(I)
    EndIf
    K=NFRE
    DoWhile(K-1<J)
    J=J-K
    K=K/2
    Loop
    J=J+K
    NextI
    '
    ForL=1ToM
    LE=2^L
    LE1=LE/2
    Ur=1#
    Ui=0#
    wr=Cos(PI/LE1)
    wi=Sin(PI/LE1)
    ForJ=0ToLE1-1
    ForI=JToNVAL-1StepLE
    IP=I+LE1
    Tr=Dr(IP)*Ur-dx(IP)*Ui
    Ti=Dr(IP)*Ui+dx(IP)*Ur
    Dr(IP)=Dr(I)-Tr
    dx(IP)=dx(I)-Ti
    Dr(I)=Dr(I)+Tr
    dx(I)=dx(I)+Ti
    NextI
    Tr=Ur
    Ti=Ui
    Ur=Tr*wr-Ti*wi
    Ui=Tr*wi+Ti*wr
    NextJ
    NextL
    '
    '
    '
    EndSub
    PublicFunctionMCorr(D1()AsDouble,D2()AsDouble,_
    ByValR1AsLong,ByValR2AsLong,_
    OptionalByValbUnbiasedAsBoolean=False,_
    OptionalByValbNoCCAsBoolean=False)AsDouble()
    '
    '   Espressione della mutua correlazione non circolare:
    '                                    I2
    '   MCorr(R) = (1 / (I2 - I1 + 1)) * Som(D1(I) * D2(I + R))   con:  N1  = UBound(D1)
    '                                    I=I1                      "    N2  = UBound(D2)
    '"   -N1 <= R1 <  R2
    '"    R1  < R2 <= N2
    '"    R1 <= R  <= R2
    '"    I1  = MAX(0, -R)
    '"    I2  = MIN(N1, N2 - R)
    '
    '   Ritorna un vettore contenente la funzione di mutua correlazione
    '   fra i dati in D1() e quelli in D2() calcolata su R1 --> R2  ritardi
    '   [i.e. MCorr(R1 To R2)].
    '   Il segnale D2() e' considerato finito e costituito da UBound(D2) + 1
    '   campioni.
    '   Se bUnbiased = True i valori della mutua correlazione vengono
    '   corretti con 1 / (N - r).
    '   Se bNoCC = True dai segnali viene eliminata la componente continua.
    '
    '   Il calcolo viene effettuato per convoluzione diretta
    '   e corretto con le equazioni di "Digital Time Series Analysis"
    '   di R. K. Otnes, L. Enochson. - pg. 247.
    '
    '   Ver. 16/10/2005 modificata per AudioCardDSP.
    '
    DimI&,I1&,I2&,N1&,N2&,r&', R1&, R2&
    DimLNorm#,dd1#(),dd2#()
    '
    N1=UBound(D1)
    N2=UBound(D2)
    '
    ReDimRR#(R1ToR2)
    ReDimMCorr(R1ToR2)
    LNorm=CDbl(MIN0(N1+1,N2+1))
    '
    ' I dati devono avere media zero?
    IfbNoCCThen
    dd1()=EliminaCC(D1())
    dd2()=EliminaCC(D2())
    Else
    dd1()=D1()
    dd2()=D2()
    EndIf
    '
    ' Calcolo la funzione di mutua correlazione:
    Forr=R1ToR2
    I1=MAX0(0,-r)
    I2=MIN0(N1,N2-r)
    ForI=I1ToI2
    RR(r)=RR(r)+dd1(I)*dd2(I+r)
    NextI
    '
    IfbUnbiasedThen
    RR(r)=RR(r)/CDbl(I2-I1+1)
    Else
    RR(r)=RR(r)/LNorm
    EndIf
    Nextr
    '
    MCorr=RR()
    '
    '
    '
    EndFunction
    PublicFunctionIIR(ByValVInAsSingle)AsSingle
    '
    '   Funzione di filtrazione IIR dei segnali.
    '   Devono essere state definite, precedentemente, le matrici
    '   Ac(0 To NK, 1 To NCel) e Bc(0 To NK, 1 To NCel) contenenti
    '   i coefficienti del filtro ed una matrice W(0 To NK, 1 To NCel)
    '   da usare come registro a scorrimento dei campioni da filtrare.
    '
    '   Codice tradotto ed adattato dal FORTRAN di:
    '"Digital Filters and their Applications"
    '     di V. Cappellini, A. G. Constantinides, P. Emiliani.
    '     pg. 373.
    '
    '   Routine modificata per strumenti di misura.
    '   -------------------------------------------
    '
    DimC&,K&,Y!
    '
    Y=VIn
    ForC=1ToNCel
    w(0,C)=Y
    Y=0!
    ForK=NKTo1Step-1
    w(0,C)=w(0,C)-Bc(K,C)*w(K,C)
    Y=Y+Ac(K,C)*w(K,C)
    w(K,C)=w(K-1,C)
    NextK
    Y=Y+Ac(0,C)*w(0,C)
    NextC
    '
    IIR=Y
    '
    '
    '
    EndFunction
    PublicFunctionFIR(ByValVInAsSingle)AsSingle
    '
    '   Funzione di filtrazione FIR dei segnali.
    '   Devono essere stati definiti, precedentemente, un vettore
    '   Hc(0 To NCoeff - 1) contenente gli NCoeff coefficienti del
    '   filtro ed un vettore SRE(-1 To NCoeff - 1) da usare come
    '   registro a scorrimento dei campioni da filtrare.
    '
    '   Codice tradotto ed adattato dal FORTRAN di:
    '"Digital Filters and their Applications"
    '     di V. Cappellini, A. G. Constantinides, P. Emiliani.
    '     pg. 371.
    '
    '   Routine modificata per strumenti di misura.
    '   -------------------------------------------
    '
    DimK&,VOut!
    '
    SRE(-1)=VIn
    ForK=UBound(SRE)To0Step-1
    SRE(K)=SRE(K-1)
    VOut=VOut+SRE(K)*Hc(K)
    NextK
    '
    FIR=VOut
    '
    '
    '
    EndFunction
    PublicSubSFFTBB(ByValNAsLong,ByValNFREAsLong,_
    Re()AsDouble,Im()AsDouble,ByRefd()AsDouble)
    '
    '   SFFTBB( X, N, MM, S1, C1, S3, C3, ITAB )
    '
    '   A real-valued, in place, split-radix IFFT program
    '   Hermitian symmetric input and real output in array X
    '   Length is N = 2 ** MM
    '   Decimation-in-frequency, cos/sin in second loop with table look-up
    '   Input order:
    '    [ Re(0), Re(1), ..., Re(N/2), Im(N/2-1), ..., Im(1) ]
    '
    '   S1 - array of sin() table (length >= N/8-1)
    '   C1 - array of cos() table (length >= N/8-1)
    '   S3 - array of sin() table (length >= N/8-1)
    '   C3 - array of cos() table (length >= N/8-1)
    '   ITAB - integer bit reversal table (length >= sqrt(2n) )
    '
    '   The initialization routine SFFTBI must be called prior to calling
    '   this routine.  SFFTBI need not be called again unless N changes.
    '
    '   Original code (IRVFFT) written by H.V. Sorensen,
    '                                     Rice University, Oct. 1985
    '
    '   Modifications made by Steve Kifowit, 26 June 1997
    '    -- table look-up of sines and cosines
    '    -- incorporation of bit reversal table
    '    -- quick return
    '
    '   Tradotta dal FORTRAN e modificata da F. Languasco 15/10/2005.
    '
    '   Entra con:
    '       N     = Numero max. di dati in D() da calcolare.
    '       NFRE  = Numero dei valori di Frequenza nei vettori Re() e Im().
    '       Re()  = Vettore dei valori Reali      della Trasformata(f).
    '       Im()  = Vettore dei valori Immaginari della Trasformata(f).
    '
    '   Esce  con:
    '       D()   = Vettore dei valori Reali del Segnale(t), ridimensionato
    '               in questa routine.
    '
    '   Gli NFRE + 1 dati nei vettori Re() e Im() sono organizzati come
    '   Vettore(0 To NFRE); gli N dati nel vettore D() sono organizzati
    '   come D(0 To N - 1).
    '
    DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
    DimN1&,N2&,N4&,N8&,NN&,It&
    DimXT#,R1#,t1#,T2#,T3#,T4#,T5#
    DimCC1#,SS1#,CC3#,SS3#
    ReDimd#(0ToN-1)
    '
    If(N=1)ThenExitSub
    '
    ' Sistemo i valori dei vettori Re(), Im() in D1():
    '    For I = 0 To NFre
    '        D1(I + 1) = Re(I)
    '    Next I
    CopyMemoryD1(1),Re(0),8*(NFRE+1)
    ForI=1ToNFRE-1
    D1(N-I+1)=Im(I)
    NextI
    '
    N2=2*N
    NN=1
    ForK=1ToMM-1
    Ic=0
    ID=N2
    N2=N2/2
    N4=N2/4
    N8=N4/2
    17ForI=IcToN-1StepID
    I1=I+1
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    t1=D1(I1)-D1(I3)
    D1(I1)=D1(I1)+D1(I3)
    D1(I2)=2*D1(I2)
    D1(I3)=t1-2*D1(I4)
    D1(I4)=t1+2*D1(I4)
    If(N4=1)ThenGoTo15
    I1=I1+N8
    I2=I2+N8
    I3=I3+N8
    I4=I4+N8
    t1=(D1(I2)-D1(I1))/Sqr2
    T2=(D1(I4)+D1(I3))/Sqr2
    D1(I1)=D1(I1)+D1(I2)
    D1(I2)=D1(I4)-D1(I3)
    D1(I3)=2*(-T2-t1)
    D1(I4)=2*(-T2+t1)
    15' CONTINUE
    NextI
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N-1)ThenGoTo17
    ForJ=2ToN8
    It=(J-1)*NN
    CC1=C1(It)
    SS1=S1(It)
    CC3=C3(It)
    SS3=S3(It)
    Ic=0
    ID=2*N2
    40ForI=IcToN-1StepID
    I1=I+J
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    I5=I+N4-J+2
    I6=I5+N4
    I7=I6+N4
    I8=I7+N4
    t1=D1(I1)-D1(I6)
    D1(I1)=D1(I1)+D1(I6)
    T2=D1(I5)-D1(I2)
    D1(I5)=D1(I2)+D1(I5)
    T3=D1(I8)+D1(I3)
    D1(I6)=D1(I8)-D1(I3)
    T4=D1(I4)+D1(I7)
    D1(I2)=D1(I4)-D1(I7)
    T5=t1-T4
    t1=t1+T4
    T4=T2-T3
    T2=T2+T3
    D1(I3)=T5*CC1+T4*SS1
    D1(I7)=-T4*CC1+T5*SS1
    D1(I4)=t1*CC3-T2*SS3
    D1(I8)=T2*CC3+t1*SS3
    30' CONTINUE
    NextI
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N-1)ThenGoTo40
    20' CONTINUE
    NextJ
    NN=2*NN
    NextK
    '
    Ic=1
    ID=4
    70ForI0=IcToNStepID
    I1=I0+1
    R1=D1(I0)
    D1(I0)=R1+D1(I1)
    D1(I1)=R1-D1(I1)
    60' CONTINUE
    NextI0
    Ic=2*ID-1
    ID=4*ID
    If(Ic<N)ThenGoTo70
    '
    N1=ITAB(1)
    ForK=2ToN1
    I0=N1*ITAB(K)+1
    I=K
    J=I0
    ForIt=2ToITAB(K)+1
    XT=D1(I)
    D1(I)=D1(J)
    D1(J)=XT
    I=I+N1
    J=I0+ITAB(It)
    101' CONTINUE
    NextIt
    100' CONTINUE
    NextK
    '
    ForI=1ToN
    D1(I)=D1(I)/N
    99' CONTINUE
    NextI
    '
    ' Sposto i dati calcolati nel vettore D():
    CopyMemoryd(0),D1(1),8*N
    '
    ' ... End of subroutine SFFTBB ...
    '
    EndSub
    PublicSubSFFTBB_Corr(Re_C()AsDouble,Im_C()AsDouble,ByRefd()AsDouble)
    '
    '   SFFTBB( X, N_C, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C )
    '
    '   A real-valued, in place, split-radix IFFT program
    '   Hermitian symmetric input and real output in array X
    '   Length is N_C = 2 ** MM_C
    '   Decimation-in-frequency, cos/sin in second loop with table look-up
    '   Input order:
    '    [ Re_C(0), Re_C(1), ..., Re_C(N_C/2), Im_C(N_C/2-1), ..., Im_C(1) ]
    '
    '   S1_C   - array of sin() table (length >= N_C/8-1)
    '   C1_C   - array of cos() table (length >= N_C/8-1)
    '   S3_C   - array of sin() table (length >= N_C/8-1)
    '   C3_C   - array of cos() table (length >= N_C/8-1)
    '   ITAB_C - integer bit reversal table (length >= sqrt(2n) )
    '
    '   The initialization routine SFFTBI_Corr must be called prior to calling
    '   this routine.  SFFTBI_Corr need not be called again unless  N1_C or
    '   N2_C change.
    '
    '   Original code (IRVFFT) written by H.V. Sorensen,
    '                                     Rice University, Oct. 1985
    '
    '   Modifications made by Steve Kifowit, 26 June 1997
    '    -- table look-up of sines and cosines
    '    -- incorporation of bit reversal table
    '    -- quick return
    '
    '   Tradotta dal FORTRAN e modificata da F. Languasco 15/10/2005.
    '
    '   Entra con:
    '       N_C     = Numero max. di dati in D() da calcolare.
    '       NFre_C  = Numero dei valori di Frequenza nei vettori Re_C() e Im_C().
    '       Re_C()  = Vettore dei valori Reali      della Trasformata(f).
    '       Im_C()  = Vettore dei valori Immaginari della Trasformata(f).
    '
    '   Esce  con:
    '       D()     = Vettore dei valori Reali del Segnale(t), ridimensionato
    '                 in questa routine.
    '
    '   Gli NFre_C + 1 dati nei vettori Re_C() e Im_C() sono organizzati come
    '   Vettore(0 To NFre_C); gli N_C dati nel vettore D() sono organizzati
    '   come D(0 To N_C - 1).
    '
    '   Ver: 22/05/2007 per MAutoCorr_FT e MMutuaCorr_FT.
    '
    DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
    DimN1&,N2&,N4&,N8&,NN&,It&
    DimXT#,R1#,t1#,T2#,T3#,T4#,T5#
    DimCC1#,SS1#,CC3#,SS3#
    ReDimd#(0ToN_C-1)
    '
    If(N_C=1)ThenExitSub
    '
    ' Sistemo i valori dei vettori Re_C(), Im_C() in D1_C():
    CopyMemoryD1_C(1),Re_C(0),8*(NFre_C+1)
    ForI=1ToNFre_C-1
    D1_C(N_C-I+1)=Im_C(I)
    NextI
    '
    N2=2*N_C
    NN=1
    ForK=1ToMM_C-1
    Ic=0
    ID=N2
    N2=N2/2
    N4=N2/4
    N8=N4/2
    17ForI=IcToN_C-1StepID
    I1=I+1
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    t1=D1_C(I1)-D1_C(I3)
    D1_C(I1)=D1_C(I1)+D1_C(I3)
    D1_C(I2)=2*D1_C(I2)
    D1_C(I3)=t1-2*D1_C(I4)
    D1_C(I4)=t1+2*D1_C(I4)
    If(N4=1)ThenGoTo15
    I1=I1+N8
    I2=I2+N8
    I3=I3+N8
    I4=I4+N8
    t1=(D1_C(I2)-D1_C(I1))/Sqr2
    T2=(D1_C(I4)+D1_C(I3))/Sqr2
    D1_C(I1)=D1_C(I1)+D1_C(I2)
    D1_C(I2)=D1_C(I4)-D1_C(I3)
    D1_C(I3)=2*(-T2-t1)
    D1_C(I4)=2*(-T2+t1)
    15' CONTINUE
    NextI
    '
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N_C-1)ThenGoTo17
    '
    ForJ=2ToN8
    It=(J-1)*NN
    CC1=C1_C(It)
    SS1=S1_C(It)
    CC3=C3_C(It)
    SS3=S3_C(It)
    Ic=0
    ID=2*N2
    40ForI=IcToN_C-1StepID
    I1=I+J
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    I5=I+N4-J+2
    I6=I5+N4
    I7=I6+N4
    I8=I7+N4
    t1=D1_C(I1)-D1_C(I6)
    D1_C(I1)=D1_C(I1)+D1_C(I6)
    T2=D1_C(I5)-D1_C(I2)
    D1_C(I5)=D1_C(I2)+D1_C(I5)
    T3=D1_C(I8)+D1_C(I3)
    D1_C(I6)=D1_C(I8)-D1_C(I3)
    T4=D1_C(I4)+D1_C(I7)
    D1_C(I2)=D1_C(I4)-D1_C(I7)
    T5=t1-T4
    t1=t1+T4
    T4=T2-T3
    T2=T2+T3
    D1_C(I3)=T5*CC1+T4*SS1
    D1_C(I7)=-T4*CC1+T5*SS1
    D1_C(I4)=t1*CC3-T2*SS3
    D1_C(I8)=T2*CC3+t1*SS3
    30' CONTINUE
    NextI
    '
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N_C-1)ThenGoTo40
    20' CONTINUE
    NextJ
    NN=2*NN
    NextK
    '
    Ic=1
    ID=4
    70ForI0=IcToN_CStepID
    I1=I0+1
    R1=D1_C(I0)
    D1_C(I0)=R1+D1_C(I1)
    D1_C(I1)=R1-D1_C(I1)
    60' CONTINUE
    NextI0
    '
    Ic=2*ID-1
    ID=4*ID
    If(Ic<N_C)ThenGoTo70
    '
    N1=ITAB_C(1)
    ForK=2ToN1
    I0=N1*ITAB_C(K)+1
    I=K
    J=I0
    ForIt=2ToITAB_C(K)+1
    XT=D1_C(I)
    D1_C(I)=D1_C(J)
    D1_C(J)=XT
    I=I+N1
    J=I0+ITAB_C(It)
    101' CONTINUE
    NextIt
    100' CONTINUE
    NextK
    '
    ForI=1ToN_C
    D1_C(I)=D1_C(I)/N_C
    99' CONTINUE
    NextI
    '
    ' Sposto i dati calcolati nel vettore D():
    CopyMemoryd(0),D1_C(1),8*N_C
    '
    ' ... End of subroutine SFFTBB ...
    '
    EndSub
    PublicFunctionSintesiFIR_WM(ByValTipo$,ByValNFiltAsLong,_
    ByValF1AsDouble,ByValF2AsDouble,ByValWNome$,ByValParAsDouble)AsBoolean
    '
    '   Sintesi del filtro con Window Method.
    '
    '   Routine modificata per strumenti di misura.
    '   -------------------------------------------
    '
    '   Parametri in ingresso.
    '    Tipo$:     Tipo di filtro:
    '"Low Pass"
    '"High Pass"
    '"Band Pass"
    '"Band Stop"
    '"Differentiator"
    '"Hilbert Trans."
    '    NFilt:     Numero di Coefficienti del filtro.
    '    F1:        Prima   Frequenza di Taglio (0 <= F1 < Fs/2).
    '    F2:        Seconda Frequenza di Taglio (F1 < F2 <= Fs/2).
    '    WNome$:    Nome del tipo di Window desiderato (vedi Function WinTipi()).
    '    Par:       Parametro per certi tipi di Windows.
    '
    '   I coefficienti del filtro vengono calcolati
    '   nel vettore Hc(0 To NFilt - 1).
    '
    DimI&,K&,KK&,NOdd&,NFilt1&
    DimAA#,Ak#,Af1#,Af2#,Den#
    ReDimHc(0ToNFilt-1),SRE(-1ToNFilt-1)
    '
    OnErrorGoToSintesiFIR_WM_ERR
    '
    NOdd=NFiltMod2
    NFilt1=Int(NFilt/2)
    AA=0.5*(1#-CDbl(NOdd))
    '
    WF()=WinProf(WNome$,NFilt,Par)
    '
    '       Impulse response evaluation
    '       ---------------------------
    '
    IfNOdd=1Then
    SelectCaseTipo$
    Case"Low Pass"
    Hc(NFilt1)=2#*F1
    Case"High Pass"
    Hc(NFilt1)=1#-2#*F1
    Case"Band Pass"
    Hc(NFilt1)=2#*(F2-F1)
    Case"Band Stop"
    Hc(NFilt1)=1#-2#*(F2-F1)
    Case"Differentiator"
    Hc(NFilt1)=0#
    Case"Hilbert Trans."
    Hc(NFilt1)=0#
    EndSelect
    EndIf
    '
    ForI=1ToNFilt1
    K=NFilt1-I
    Ak=CDbl(I)-AA
    Af1=PI2*Ak*F1
    Af2=PI2*Ak*F2
    Den=PI*Ak
    '
    SelectCaseTipo$
    Case"Low Pass"
    Hc(K)=Sin(Af1)/Den
    '
    Case"High Pass"
    Hc(K)=(Sin(PI*Ak)-Sin(Af1))/Den
    '
    Case"Band Pass"
    Hc(K)=(Sin(Af2)-Sin(Af1))/Den
    '
    Case"Band Stop"
    Hc(K)=(Sin(PI*Ak)-Sin(Af2)+Sin(Af1))/Den
    '
    Case"Differentiator"
    Hc(K)=-(Sin(Af1)-Af1*Cos(Af1))/(Den*Den)
    '
    Case"Hilbert Trans."
    Hc(K)=-(Cos(Af1)-Cos(Af2))/Den
    EndSelect
    '
    ' Windowing:
    Hc(K)=Hc(K)*WF(K)
    NextI
    '
    '
    ForK=0ToNFilt1-1
    KK=NFilt-1-K
    Hc(KK)=Switch(Tipo$="Differentiator",-Hc(K),_
    Tipo$="Hilbert Trans.",-Hc(K),_
    True,Hc(K))
    NextK
    '
    '
    SintesiFIR_WM_ERR:
    SintesiFIR_WM=(Err.Number=0)
    If(Err.Number<>0)Then
    DimM$
    M$=FiltroErrFIR$&vbNewLine&vbNewLine
    M$=M$&"Errore "&Str$(Err.Number)&vbNewLine
    M$=M$&Err.Description
    MsgBoxM$,vbCritical," modDSP: SintesiFIR_WM"
    EndIf
    '
    '
    '
    EndFunction
    PublicFunctionSintesiIIR_BT(ByValTrans$,ByValProty$,ByRefFCtAsDouble,_
    OptionalByValFAtAsDouble,OptionalByValAttAsDouble,OptionalByValRipAsDouble,_
    OptionalByValF1AsDouble,OptionalByValF2AsDouble,_
    OptionalByValqAsDouble,OptionalByRefAttTotAsDouble,_
    OptionalByRefAlfaAsDouble)AsBoolean
    '
    '   Sintesi del filtro richiesto con il metodo
    '   di Trasformazione Bilineare.
    '
    '   Routine modificata per strumenti di misura.
    '   -------------------------------------------
    '
    '   Parametri in ingresso.
    '    Trans$:    Tipo di Trasformazione richiesta:
    '"No Transformation"               JBT = 0
    '"Low Pass -> Low Pass"            JBT = 1
    '"Low Pass -> High Pass"           JBT = 2
    '"Low Pass -> Band Pass"           JBT = 3
    '"Low Pass -> Band Stop"           JBT = 4
    '               Filtri elementari:
    '"RC Type Low Pass Filter"         JBT = 5
    '"RC Type High Pass Filter"        JBT = 6
    '"Resonator"                       JBT = 7
    '"Notch Filter"                    JBT = 8
    '"U(t) = a·I(t) + (1-a)·U(t-1)"    JBT = 9
    '    Proty$:    Tipo di prototipo Passa Basso:
    '"Butterworth"
    '"Chebyshev"
    '    FCt:       Frequenza di taglio (con atten. di -3 dB)
    '               o di risonanza (solo per JBT = 7 e JBT = 8).
    '    FAt:       Per JBT < 5 e' la frequenza alla quale
    '               l' attenuazione deve essere di almeno Att# dB.
    '    Att:       Attenuazione desiderata in [dB] alla frequenza FAt#.
    '    Rip:       Ondulazione in Banda Passante espressa come
    '               percentuale del guadagno (solo per Chebyshev).
    '    F1:        Prima frequenza di taglio dopo la trasformazione.
    '    F2:        Seconda frequenza di taglio dopo la trasformazione.
    '    Q:         Solo per JBT = 7 e JBT = 8, e' il Q del risonatore.
    '    Alfa:      Alfa dato per filtro JBT = 9; per specificare, invece,
    '               la FCt passare Alfa = -1.
    '
    '   Parametri in uscita
    '    AttTot:    Attenuazione ottenuta in [dB] alla frequenza FAt#.
    '    FCt:       Frequenza di taglio ottenuta per filtro JBT = 9 con Alfa dato.
    '    Alfa:      Alfa ottenuto per filtro JBT = 9 con FCt dato.
    '
    '   I coefficienti del filtro vengono calcolati nelle
    '   matrici Ac(0 To NK, 1 To NCel) e Bc(0 To NK, 1 To NCel)
    '   con NK = ordine del filtro e NCel = numero di sezioni.
    '   In questa versione viene anche dimensionata la matrice
    '   W() dei registri delle sezioni del filtro.
    '
    DimN&,I&,K&,NC&,M$
    DimOm#,Cm#,a#,A0#,A1#,A2#,B0#,B1#,B2#' Variabili per filtri elementari.
    Dimf#,FF#,FCTA#,FATA#,Eps#,ATL#,res#' Variabili per
    DimAB#,AT#,Bt#,TETAP#,P1#,P2#,P3#' filtri di tipo
    DimCAPPA#,COSTA#,TOT#,CC#,AL#,Rn#' Butterworth e Chebyshev.
    '
    OnErrorGoToSintesiIIR_BT_ERR
    '
    '-- Filtri elementari ------------------------------------------------------------------
    If(Trans$="RC Type Low Pass Filter")_
    Or(Trans$="RC Type High Pass Filter")_
    Or(Trans$="U(t) = a·I(t) + (1-a)·U(t-1)")Then
    ' Calcolo di tipi di filtro elementari del 1° ordine.
    ' Vedi Sub zNote:
    Om=PI2*FCt' Pulsazione di taglio [rad/s].
    '
    SelectCaseTrans$
    Case"RC Type Low Pass Filter"
    Cm=Om/Tan(PI*FCt)' Costante di mappatura.
    a=1#+Cm/Om
    A0=1#/a
    A1=1#/a
    B0=1#
    B1=(1#-Cm/Om)/a
    '
    Case"RC Type High Pass Filter"
    Cm=Om/Tan(PI*FCt)' Costante di mappatura.
    a=1#+Cm/Om
    A0=(Cm/Om)/a
    A1=-(Cm/Om)/a
    B0=1#
    B1=(1#-Cm/Om)/a
    '
    Case"U(t) = a·I(t) + (1-a)·U(t-1)"
    ' a := Alfa
    If(Alfa<0#)Then
    ' E' data FCt; calcola Alfa per avere la FCt voluta:
    Alfa=Cos(Om)-1#+Sqr(Cos(Om)^2-4#*Cos(Om)+3#)
    ElseIf(Alfa<2#*(Sqr2-1#))Then
    ' E' data Alfa; calcola la FCt (se < 0.5) corrispondente:
    Om=Acos(((Alfa^2)+2#*Alfa-2#)/(2#*Alfa-2#))
    FCt=Om/PI2
    EndIf
    A0=Alfa
    A1=0#
    B0=1#
    B1=-(1#-Alfa)
    EndSelect
    '
    NCel=1
    NK=1
    ReDimAc(0ToNK,1ToNCel)' Coefficienti del filtro
    ReDimBc(0ToNK,1ToNCel)' calcolati in Doppia Precisione.
    ReDimw(0ToNK,1ToNCel)
    Ac(0,1)=A0
    Ac(1,1)=A1
    Bc(0,1)=B0
    Bc(1,1)=B1
    AttTot=1#
    '
    GoToSintesiIIR_BT_End
    '
    ElseIf(Trans$="Resonator")_
    Or(Trans$="Notch Filter")Then
    ' Calcolo di tipi di filtro elementari del 2° ordine.
    ' Vedi Sub zNote:
    Om=PI2*FCt' Pulsazione di risonanza [rad/s].
    Cm=Om/Tan(PI*FCt)' Costante di mappatura.
    '
    ' Calcola i poli:
    a=1#+Cm/(q*Om)+(Cm^2/Om^2)
    B0=1#
    B1=2#*(1#-Cm^2/Om^2)/a
    B2=(1#-Cm/(q*Om)+(Cm^2/Om^2))/a
    '
    SelectCaseTrans$
    Case"Resonator"
    ' Mette due zeri reali a ± 1:
    A0=Cm/a
    A1=0#
    A2=-Cm/a
    '
    Case"Notch Filter"
    ' Mette una coppia di zeri complessi coniugati:
    Rn=Sqr(B2)
    ' TETAP = Acos(-B1 / (2# * Rn))
    A0=1#
    A1=B1/Rn' -2 * Cos(TETAP)
    A2=1#' Cos(TETAP) ^ 2 + Sin(TETAP) ^ 2
    EndSelect
    '
    NCel=1
    NK=2
    ReDimAc(0ToNK,1ToNCel)' Coefficienti del filtro
    ReDimBc(0ToNK,1ToNCel)' calcolati in Doppia Precisione.
    ReDimw(0ToNK,1ToNCel)
    Ac(0,1)=A0
    Ac(1,1)=A1
    Ac(2,1)=A2
    Bc(0,1)=B0
    Bc(1,1)=B1
    Bc(2,1)=B2
    AttTot=1#
    '
    GoToSintesiIIR_BT_End
    EndIf
    '
    '-- Filtri Butterworth e Chebyshev -----------------------------------------------------
    FCTA=Tan(PI*FCt)
    FATA=Tan(PI*FAt)
    FF=FATA/FCTA
    If(Proty$="Chebyshev")ThenEps=Sqr(1#/(1#-Rip/100#)^2#-1#)
    ATL=10#^(Att/10#)
    '
    '       COMPUTATION OF THE ORDER OF THE FILTER.
    '       ---------------------------------------
    '
    N=0
    Do
    N=N+1
    SelectCaseProty$
    Case"Butterworth"
    res#=1#/(1#+FF^(2*N))
    '
    Case"Chebyshev"
    CEB(1)=1#
    CEB(2)=FF
    If(1<N)Then
    f=FF+FF
    ForI=2ToN
    CEB(I+1)=f*CEB(I)-CEB#(I-1)
    NextI
    EndIf
    res=1#/(1#+(Eps*CEB(N+1))^2)
    EndSelect
    LoopWhileres>=ATL
    '
    If((NMod2)=1)Then
    N=N+1
    SelectCaseProty$
    Case"Butterworth"
    res=1#/(1#+FF^(2*N))
    '
    Case"Chebyshev"
    CEB(1)=1
    CEB(2)=FF
    f=FF+FF
    ForI=2ToN
    CEB(I+1)=f*CEB(I)-CEB(I-1)
    NextI
    res=1#/(1#+(Eps*CEB(N+1))^2)
    EndSelect
    EndIf
    '
    If(2*NCMax<N)Then
    M$="**** ERRORE ****"&vbNewLine
    M$=M$&vbNewLine&"Per ottenere il filtro richiesto"&vbNewLine
    M$=M$&"si devono usare "&Str$(N/2)&" Sezioni."&vbNewLine
    M$=M$&"Il numero Massimo e'"&Str$(NCMax)&"."&vbNewLine
    M$=M$&vbNewLine&"Provare a variare i dati del filtro."
    MsgBoxM$,vbCritical," modDSP: Sintesi IIR"
    SintesiIIR_BT=False
    DoEvents
    ExitFunction
    EndIf
    '
    AttTot=10#*Log(res)/Log10
    NCel=N/2
    NK=Switch(Trans$="No Transformation",2,_
    Trans$="Low Pass -> Low Pass",2,_
    Trans$="Low Pass -> High Pass",2,_
    Trans$="Low Pass -> Band Pass",4,_
    Trans$="Low Pass -> Band Stop",4)
    ReDimAc(0ToNK,1ToNCel)' Coefficienti del filtro.
    ReDimBc(0ToNK,1ToNCel)' Calcolati in Doppia Precisione.
    ReDimPOLRE(1ToNCel)' Vettori in uso durante la Sintesi.
    ReDimPOLIM(1ToNCel)'""""
    ReDimw(0ToNK,1ToNCel)
    '
    '       POLE POSITION EVALUATION.
    '       -------------------------
    '
    AT=FCTA
    Bt=FCTA
    If(Proty$="Chebyshev")Then
    AB=((1#+Sqr(1#+Eps^2))/Eps)^(1#/N)
    AT=(AB-1#/AB)*AT/2#
    Bt=(AB+1#/AB)*Bt/2#
    EndIf
    ForNC=1ToNCel
    TETAP=PI#*(2#*NC-1#)/(2#*N)
    POLRE(NC)=-AT*Cos(TETAP)
    POLIM(NC)=Bt*Sin(TETAP)
    NextNC
    ForNC=1ToNCel
    P1=POLIM(NC)^2
    P2=(1#-POLRE(NC))^2
    P3=POLRE(NC)^2
    POLRE(NC)=(1#-P3-P1)/(P2+P1)
    POLIM(NC)=(2#*POLIM(NC))/(P2+P1)
    NextNC
    '
    '       EVALUATION OF THE SECOND ORDER SECTION COEFFICIENTS.
    '       ----------------------------------------------------
    '
    ForNC=1ToNCel
    Bc(0,NC)=1#
    Bc(1,NC)=-2#*POLRE(NC)
    Bc(2,NC)=POLRE(NC)*POLRE(NC)+POLIM(NC)*POLIM(NC)
    NextNC
    '
    SelectCaseProty$
    Case"Butterworth"
    COSTA=1#
    '
    Case"Chebyshev"
    COSTA=(1#-Rip/100#)^(1#/NCel)
    EndSelect
    '
    ForNC=1ToNCel
    TOT=4#/(Bc(0,NC)+Bc(1,NC)+Bc(2,NC))
    CC=TOT/COSTA
    Ac(0,NC)=1#/CC
    Ac(1,NC)=2#/CC
    Ac(2,NC)=1#/CC
    NextNC
    '
    '       FREQUENCY TRANSFORMATION.
    '       -------------------------
    '
    SelectCaseTrans$
    Case"No Transformation"
    GoToSintesiIIR_BT_End
    '
    Case"Low Pass -> Low Pass"
    AL=Sin(PI*(FCt-F1))/Sin(PI*(FCt+F1))
    A0=-AL
    A1=1#
    A2=0#
    B0=A1
    B1=A0
    B2=0#
    '
    Case"Low Pass -> High Pass"
    AL=-Cos(PI*(FCt+F1))/Cos(PI*(FCt-F1))
    A0=-AL
    A1=-1#
    A2=0#
    B0=-A1
    B1=-A0
    B2=0#
    '
    Case"Low Pass -> Band Pass"
    AL=Cos(PI*(F2+F1))/Cos(PI*(F2-F1))
    CAPPA=Tan(PI*FCt)/Tan(PI*(F2-F1))
    A0=-(CAPPA-1#)/(CAPPA+1#)
    A1=2#*AL*CAPPA#/(CAPPA+1#)
    A2=-1#
    B0=-A2
    B1=-A1
    B2=-A0
    '
    Case"Low Pass -> Band Stop"
    AL=Cos(PI*(F2+F1))/Cos(PI*(F2-F1))
    CAPPA=Tan(PI*FCt)*Tan(PI*(F2-F1))
    A0=(1#-CAPPA)/(1#+CAPPA)
    A1=-2#*AL/(1#+CAPPA)
    A2=1#
    B0=A2
    B1=A1
    B2=A0
    EndSelect
    '
    AN(0,0)=B0*B0
    AN(1,0)=2#*B0*B1
    AN(2,0)=B1*B1+2#*B0*B2
    AN(3,0)=2#*B1*B2
    AN(4,0)=B2*B2
    AN(0,1)=A0*B0
    AN(1,1)=A0*B1+A1*B0
    AN(2,1)=A0*B2+A1*B1+A2*B0
    AN(3,1)=A1*B2+A2*B1
    AN(4,1)=A2*B2
    AN(0,2)=A0*A0
    AN(1,2)=2#*A0*A1
    AN(2,2)=A1*A1+2#*A0*A2
    AN(3,2)=2#*A1*A2
    AN(4,2)=A2*A2
    '
    ForNC=1ToNCel
    ForK=0To2
    FINA(K)=Ac(K,NC)
    FINB(K)=Bc(K,NC)
    NextK
    ForK=0ToNK
    Ac(K,NC)=0#
    Bc(K,NC)=0#
    ForI=0To2
    Ac(K,NC)=AN(K,I)*FINA(I)+Ac(K,NC)
    Bc(K,NC)=AN(K,I)*FINB(I)+Bc(K,NC)
    NextI
    NextK
    NextNC
    ForNC=1ToNCel
    Rn=Bc(0,NC)
    ForK=0ToNK
    Ac(K,NC)=Ac(K,NC)/Rn
    Bc(K,NC)=Bc(K,NC)/Rn
    NextK
    NextNC
    '
    '
    SintesiIIR_BT_End:
    SintesiIIR_BT_ERR:
    SintesiIIR_BT=(Err.Number=0)
    If(Err.Number<>0)Then
    M$=FiltroErrIIR$&vbNewLine&vbNewLine
    M$=M$&"Errore "&Str$(Err.Number)&vbNewLine
    M$=M$&Err.Description
    MsgBoxM$,vbCritical," modDSP: SintesiIIR_BT"
    EndIf
    '
    '
    '
    EndFunction
    PrivateSubzNote()
    '
    '   Metodi di calcolo dei filtri elementari.
    '   - Algoritmi di trasformazione da "Digital Signal Processing"
    '     di W. D. Stanley - pg. 172, 173, 174.
    '   - La funzione di trasferimento del risuonatore reale parallelo
    '     e' tratta da "Teoria delle Reti Elettriche", Appunti dai
    '     corsi del Politecnico di Torino - pg. (1.3)1 e seg.
    '   - L' idea della sostituzione degli zeri per il "Notch Filter"
    '     proviene da: http://www-users.cs.york.ac.uk/~fisher/mkfilter/res.html
    '
    '---------------------------------------------------------------------------------------
    '"RC Type Low Pass Filter":
    '   La funzione di trasferimento e':
    '
    '   U(p)       1                    con:
    '   ---- = -----------               Fc = 1/(2*PI*RC)   frequenza di taglio a -3 dB [Hz].
    '   I(p)   1 + RC*p                  C, R               capacita' e resistenza
    '                                                       del circuito.
    '
    '   Le formule di trasformazione (1) da:
    '
    '           A0 + A1*p                 1
    '    G(p) = ---------   -->  -------------------
    '           B0 + B1*p        1 + (1/(2*PI*Fc))*p
    '   a:
    '                    -1
    '           a0 + a1*z
    '    H(z) = -----------
    '                    -1
    '           1  + b1*z
    '
    '   sono:                           con:
    '    Cm = 2*PI*FCt/Tan(2*PI*FCt/2)   FCt = Fc/Fs  -->  0 <= FCt <= 0.5
    '    A  =  B0 + B1*Cm                A0 = 1
    '    a0 = (A0 + A1*Cm)/A             A1 = 0
    '    a1 = (A0 - A1*Cm)/A             B0 = 1
    '    b1 = (B0 - B1*Cm)/A             B1 = 1/(2*PI*FCt)
    '
    '
    '---------------------------------------------------------------------------------------
    '"RC Type High Pass Filter":
    '   La funzione di trasferimento e':
    '
    '   U(p)      RCp                   con:
    '   ---- = -----------               Fc = 1/(2*PI*RC)   frequenza di taglio a -3 dB [Hz].
    '   I(p)   1 + RC*p                  C, R               capacita' e resistenza
    '                                                       del circuito.
    '
    '   si usano le formule di trasformazione (1) con:
    '                                              FCt = Fc/Fs  -->  0 <= FCt <= 0.5
    '                                              A0 = 0
    '                                              A1 = 1/(2*PI*FCt)
    '                                              B0 = 1
    '                                              B1 = 1/(2*PI*FCt)
    '
    '
    '---------------------------------------------------------------------------------------
    '"Resonator":
    '   La funzione di trasferimento e':
    '
    '    U(p)                  P                    con:
    '    ---- = ---------------------------------    Oc = 1/Sqr(L*C)    pulsazione di risonanza [rad/s].
    '    I(P)   1 + (1/(Q*Oc))*P + (1/(Oc^2))*P^2    Fc = Oc/(2*PI)     frequenza di risonanza [Hz].
    '                                                L, C, Rp           induttanza, capacita' e
    '                                                                   resistenza in parallelo
    '                                                                   del circuito risonante.
    '                                                Q = Oc*Rp*C        coefficiente di risonanza.
    '
    '   Le formule di trasformazione (2) da:
    '
    '           A0 + A1*p + A2*p^2                         p
    '    G(p) = ------------------   -->  ---------------------------------
    '           B0 + B1*p + B2*p^2        1 + (1/(Q*Oc))*P + (1/(Oc^2))*P^2
    '   a:
    '                    -1     -2
    '           a0 + a1*z + a2*z
    '    H(z) = ------------------
    '                    -1     -2
    '           1  + b1*z + b2*z
    '
    '   sono:                             con:
    '    Cm = 2*PI*FCt/Tan(2*PI*FCt/2)     FCt = Fc/Fs  -->  0 <= FCt <= 0.5
    '    A  =  B0 + B1*Cm + B2*Cm^2        A0 = 0
    '    a0 = (A0 + A1*Cm + A2*Cm^2)/A     A1 = 1
    '    a1 = (2*A0 - 2*A2*Cm^2)/A         A2 = 0
    '    a2 = (A0 - A1*Cm + A2*Cm^2)/A     B0 = 1
    '    b1 = (2*B0 - 2*B2*Cm^2)/A         B1 = 1/(2*PI*FCt*Q)
    '    b2 = (B0 - B1*Cm + B2*Cm^2)/A     B2 = 1/(2*PI*FCt)^2
    '
    '---------------------------------------------------------------------------------------
    '"Notch Filter":
    '   L' algoritmo precedente costruisce una funzione di trasferimento H(z) avente
    '   una coppia di zeri reali a ± 1; questo consente di avere guadagno zero alle
    '   basse ed alle alte frequenze.
    '   Il "Notch Filter" viene ricavato dal "Resonator" sostituendo questa coppia di
    '   zeri reali con due zeri complessi coniugati, giacenti sul cerchio unitario e
    '   con argomento uguale a quello dei poli (anch' essi complessi coniugati).
    '
    '   Se Zp = r*Exp(± i*Theta) sono i poli di H(z), gli zeri devono essere:
    '
    '    Zz = Exp(± i*Theta)
    '
    '   Viene usata la relazione:
    '
    '                          -1                        -1
    '    (1 - r*Exp(+i*Theta)*z  )*(1 - r*Exp(-i*Theta)*z  ) =
    '
    '                          -1   2   -2           -1      -2
    '    = 1 - 2*r*Cos(Theta)*z  + r * z   = 1 + b1*z  + b2*z       (i = Sqr(-1))
    '
    '   da cui:
    '
    '    r = Sqr(b2)
    '    Theta = Acos(-b1/(2*Sqr(b2))
    '
    '   e quindi:
    '
    '             -1     -2                       -1  -2
    '    a0 + a1*z + a2*z  = 1 + (b1/(2*Sqr(b2))*z + z
    '
    '---------------------------------------------------------------------------------------
    '"U(t) = a·I(t) + (1-a)·U(t-1)"
    '   La funzione di trasferimento e':
    '
    '                a
    '    H(z) = ----------------
    '                         -1
    '           1  - (1 - a)*z
    '
    '   Usando, invertite, le formule di trasformazione (1) si ha:
    '
    '              a*Cm - a*p
    '    G(p) = ---------------             con: Cm = Oc/Tan(Oc/2)
    '           a*Cm + (2 - a)*p                 Oc = 2*PI*Fc
    '
    '   La pulsazione di taglio Oc si ha per:
    '
    '          |a*Cm - a*i*Oc|       1
    '    ----------------------- = ------   con: p = i*Oc
    '      |a*Cm + (2 - a)*i*Oc|   Sqr(2)        i = Sqr(-1)
    '
    '   da cui si ricava il valore di a necessario per
    '   ottenere la frequenza di taglio FCt voluta:
    '
    '    a = Cos(Oc) - 1 + Sqr(Cos(Oc)^2 - 4*Cos(Oc) + 3)   sempre con: Oc  = 2*PI*FCt
    '                                                                   FCt = Fc/Fs
    '
    '   Se invece viene dato a, si ottiene una FCt corrispondente:
    '
    '    FCt = Acos(((a^2) + 2*a - 2)/(2*a - 2))/(2*PI)     solo per:   a   < 2*(Sqr(2) - 1)
    '                                                       e:          FCt < 0.5
    '
    '
    '
    EndSub
    SubDFT(ByValNVAL&,d()AsDouble,r()AsDouble,X()AsDouble,_
    s()AsDouble,f()AsDouble,ByValNFRE&)
    '
    '   Definizioni:
    '
    '   DFT = Discrete Fourier Transform.
    '
    '   Entra con:
    '       NVAL   = Numero max. dei dati in D() da usare.
    '       D()    = Vettore dei dati Reali del Segnale(t).
    '       NFRE   = Numero  dei valori di Frequenza calcolati.
    '
    '   Esce  con:
    '       R()    = Vettore dei valori Reali      della Trasformata(f).
    '       X()    = Vettore dei valori Immaginari della Trasformata(f).
    '       S()    = Vettore dello Spettro di Amp. della Trasformata(f).
    '       F()    = Vettore delle Fasi            della Trasformata(f) [rad].
    '
    '   I valori della trasformata in R(), X() NON vengono
    '   normalizzati sulla lunghezza del Segnale NVAL.
    '
    '   Gli NVAL dati nel vettore D() sono organizzati come D(0 To NVAL - 1).
    '   Gli NFRE dati nei vettori R(), X(), S() e F() sono organizzati come Vettore(0 To NFRE).
    '
    '   Viene calcolata in R(0 To NFRE), X(0 To NFRE) solo la prima
    '   meta' dello spettro per i valori di frequenza  NFRE = NVAL/2
    '   piu' la Componente Continua in R(0).
    '
    '   Algoritmi tratti da: "Digital Time Series Analysis" di R. Otnes
    '   e L. Enochson - pg. 138.  Nessun tentativo e' stato fatto per
    '   migliorare la velocita' di esecuzione (tipo look-up table e/o
    '   valutazione ricorsiva delle funzioni trigonometriche).
    '
    DimJF&,JD&,PI2_V#,Omega#,OmT#,NFRE_D#
    '
    'NFRE = Int(NVAL / 2)
    NFRE_D=CDbl(NVAL)/2#
    PI2_V=PI2/CDbl(NVAL)
    '
    ForJF=0ToNFRE
    Omega=PI2_V*CDbl(JF)
    r(JF)=0#
    X(JF)=0#
    '
    ForJD=0ToNVAL-1
    OmT=Omega*CDbl(JD)
    r(JF)=r(JF)+d(JD)*Cos(OmT)
    X(JF)=X(JF)+d(JD)*Sin(OmT)
    NextJD
    NextJF
    '
    ' Calcolo dello Spettro di Ampiezza e delle Fasi:
    s(0)=Abs(r(0))/CDbl(NVAL)
    f(0)=IIf(r(0)<0#,PI,0#)
    ForJF=1ToNFRE-1
    s(JF)=Sqr(r(JF)*r(JF)+X(JF)*X(JF))/NFRE_D
    f(JF)=DATAN2(-X(JF),r(JF))' Scala da -PI a  +PI.
    'F(JF) = Atan2(-X(JF), R(JF))    ' Scala da 0 a  +2PI.
    NextJF
    If(NVALMod2)=0Then
    s(NFRE)=Abs(r(NFRE))/CDbl(NVAL)
    f(NFRE)=IIf(r(NFRE)<0#,PI,0#)
    Else
    s(NFRE)=Sqr(r(NFRE)*r(NFRE)+X(NFRE)*X(NFRE))/NFRE_D
    f(NFRE)=DATAN2(-X(NFRE),r(NFRE))' Scala da -PI a  +PI.
    'F(NFre) = Atan2(-X(NFre), R(NFre))  ' Scala da 0 a  +2PI.
    EndIf
    '
    '
    '
    EndSub
    PublicSubFFT(d()AsDouble,r()AsDouble,X()AsDouble,_
    s()AsDouble,f()AsDouble,ByRefNVALAsLong,ByRefNFREAsLong)
    '
    '   Definizioni:
    '
    '   FFT = Fast Fourier Transform.
    '
    '   Entra con:
    '       D()   = Vettore dei dati Reali del Segnale(t).
    '       NVAL  = Numero max. dei dati in D() da usare.
    '
    '   Esce  con:
    '       R()   = Vettore dei valori Reali      della Trasformata(f).
    '       X()   = Vettore dei valori Immaginari della Trasformata(f).
    '       S()   = Vettore dello Spettro di Amp. della Trasformata(f).
    '       F()   = Vettore delle Fasi            della Trasformata(f) [Radianti].
    '       NVAL  = Numero  dei dati usati        dalla Trasformata(f).
    '       NFRE  = Numero  dei valori di Frequenza calcolati.
    '
    '   I valori della Trasformata in R(), X() NON vengono
    '   normalizzati sulla lunghezza del Segnale 2^M.
    '
    '   I vettori R(), X(), S() e F() sono dimensionati in questa routine.
    '   Gli NN dati nei vettori sono organizzati come Vettore(0 To NN - 1).
    '
    '   Tradotta in Basic da: "Theory and Application of Digital
    '   Signal Processing" di L. Rabiner e B. Gold. - pg. 367.
    '
    '   Ver. 18/10/2005 modificata per AudioCardDSP.
    '
    DimM&,I&,NMN1&,J&,K&,L&,LE&,LE1&,IP&,JF&
    DimTSwap#,Ur#,Ui#,wr#,wi#,Tr#,Ti#
    '
    M=Int(Log(CDbl(NVAL)+0.5)/Log2)
    NVAL=2^M
    NFRE=NVAL/2
    NMN1=NVAL-1
    '
    ReDimr(0ToNVAL-1),X(0ToNVAL-1)
    ReDims(0ToNFRE),f(0ToNFRE)
    '
    ' Solo per segnali di ingresso reali e se non si vogliono
    ' sfruttare le proprieta'"transform-in-place" di questa
    ' implementazione:
    ForI=0ToNVAL-1
    r(I)=d(I)
    X(I)=0#' Per segnali di ingresso complessi
    ' mettere la componente immaginaria.
    NextI
    '
    J=0
    ForI=0ToNMN1-1
    If(I<J)Then
    ' dSwap R(J), R(I):
    TSwap=r(J)
    r(J)=r(I)
    r(I)=TSwap
    'dSwap X(J), X(I) ' Solo per segnali complessi.
    EndIf
    K=NFRE
    DoWhile(K-1<J)
    J=J-K
    K=K/2
    Loop
    J=J+K
    NextI
    '
    ForL=1ToM
    LE=2^L
    LE1=LE/2
    Ur=1#
    Ui=0#
    wr=Cos(PI/LE1)
    wi=Sin(PI/LE1)
    ForJ=0ToLE1-1
    ForI=JToNVAL-1StepLE
    IP=I+LE1
    Tr=r(IP)*Ur-X(IP)*Ui
    Ti=r(IP)*Ui+X(IP)*Ur
    r(IP)=r(I)-Tr
    X(IP)=X(I)-Ti
    r(I)=r(I)+Tr
    X(I)=X(I)+Ti
    NextI
    Tr=Ur
    Ti=Ui
    Ur=Tr*wr-Ti*wi
    Ui=Tr*wi+Ti*wr
    NextJ
    NextL
    '
    ' Calcolo dello Spettro di Ampiezza e delle Fasi:
    s(0)=Abs(r(0))/NVAL
    f(0)=IIf(r(0)<0#,PI,0#)
    ForJF=1ToNFRE-1
    s(JF)=Sqr(r(JF)*r(JF)+X(JF)*X(JF))/NFRE
    f(JF)=DATAN2(-X(JF),r(JF))' Scala da -PI a  +PI.
    'F(JF) = Atan2(-X(JF), R(JF))    ' Scala da 0 a  +2PI.
    NextJF
    s(NFRE)=Abs(r(NFRE))/NVAL
    f(NFRE)=IIf(r(NFRE)<0#,PI,0#)
    '
    '
    '
    EndSub
    PublicFunctionWinProf(ByValWNome$,ByValNWind&,OptionalByValParAsDouble)AsDouble()
    '
    '   Calcola e ritorna un vettore con i coefficienti della Window richiesta.
    '    WNome$:    nome della Window richiesta.
    '    NWind:     N° di coefficienti richiesto.
    '    Par:       parametro richiesto per certi tipi di Window.
    '
    DimK&,KK&,NOdd&,NWind1&
    DimBB#,AA#,Ak#,Arg#,ArgL#,ArgW#,NWind_1#
    ReDimWF_I#(0ToNWind-1)
    '
    NOdd=NWindMod2
    NWind1=Int(NWind/2)
    If(NOdd=1)ThenWF_I(NWind1)=1#
    NWind_1=CDbl(NWind-1)
    '
    AA=0.5*(1#-CDbl(NOdd))
    BB=CDbl(NWind1)-AA
    '
    ' Calcolo la prima meta' del vettore:
    SelectCaseWNome$
    Case"Bartlett"
    ' Zero valued end-points:
    ForK=0ToNWind1-1
    WF_I(K)=(2#/NWind_1)*((NWind_1/2#)-Abs(K-(NWind_1/2#)))
    NextK
    '
    Case"Bartlett-Hann"
    ForK=0ToNWind1-1
    WF_I(K)=0.62-0.48*(Abs((K/NWind_1)-0.5))_
    -0.38*Cos(PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Blackman"
    ForK=0ToNWind1-1
    WF_I(K)=0.42_
    -0.5*Cos(PI2*CDbl(K)/NWind_1)_
    +0.08*Cos(2#*PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Blackman-Harris"
    ForK=0ToNWind1-1
    WF_I(K)=0.35875_
    -0.48829*Cos(1#*PI2*CDbl(K)/NWind_1)_
    +0.14128*Cos(2#*PI2*CDbl(K)/NWind_1)_
    -0.01168*Cos(3#*PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Blackman-Nuttal"
    ForK=0ToNWind1-1
    WF_I(K)=0.3635819_
    -0.4891775*Cos(1#*PI2*CDbl(K)/NWind_1)_
    +0.1365995*Cos(2#*PI2*CDbl(K)/NWind_1)_
    -0.0106411*Cos(3#*PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Flat top"
    ForK=0ToNWind1-1
    WF_I(K)=0.21557895_
    -0.41663158*Cos(1#*PI2*CDbl(K)/NWind_1)_
    +0.2772631*Cos(2#*PI2*CDbl(K)/NWind_1)_
    -0.083578947*Cos(3#*PI2*CDbl(K)/NWind_1)_
    +0.006947368*Cos(4#*PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Gauss"
    ForK=0ToNWind1-1
    WF_I(K)=Exp(-0.5*((K-NWind_1/2)/(Par*NWind_1/2))^2)
    NextK
    '
    Case"Hamming generalizzata"
    ForK=0ToNWind1-1
    WF_I(K)=Par-(1#-Par)*Cos(PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Hamming"
    ' E' l'"Hamming generalizzata" con Par = 0.54:
    ForK=0ToNWind1-1
    WF_I(K)=0.54-0.46*Cos(PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Hanning"
    ' E' l'"Hamming generalizzata" con Par = 0.5:
    ForK=0ToNWind1-1
    WF_I(K)=0.5-0.5*Cos(PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Kaiser"
    ForK=0ToNWind1-1
    Ak=Par*Sqr(1#-((2#*CDbl(K)/NWind_1)-1#)^2)
    WF_I(K)=I0_Kaiser(Ak)/I0_Kaiser(Par)
    NextK
    '
    Case"Lanczos"
    ArgL=PI/BB
    ForK=0ToNWind1-1
    Ak=CDbl(NWind1-K)-AA
    Arg=ArgL*Ak
    WF_I(K)=Abs(Sin(Arg)/Arg)^Par
    NextK
    '
    Case"Nuttal"
    ForK=0ToNWind1-1
    WF_I(K)=0.355768_
    -0.487396*Cos(1#*PI2*CDbl(K)/NWind_1)_
    +0.144232*Cos(2#*PI2*CDbl(K)/NWind_1)_
    -0.012604*Cos(3#*PI2*CDbl(K)/NWind_1)
    NextK
    '
    Case"Rettangolare"
    ForK=0ToNWind1-1
    WF_I(K)=1#
    NextK
    '
    Case"Triangolare"
    ForK=0ToNWind1-1
    'WF_I(K) = CDbl(K) / CDbl(NWind1)
    '
    ' Non-zero end-points:
    WF_I(K)=(2#/NWind)*((NWind/2#)-Abs(K-(NWind_1/2#)))
    NextK
    '
    Case"Weber"
    ArgW=1.5*Par/BB
    ForK=0ToNWind1-1
    Ak=CDbl(NWind1-K)-AA
    Arg=ArgW*Ak
    If(Arg<=0.75)Then
    WF_I(K)=A0+A1*Arg+A2*Arg^2+A3*Arg^3
    Else
    WF_I(K)=B0+B1*Arg+B2*Arg^2+B3*Arg^3
    EndIf
    NextK
    '
    Case"Welch"
    ForK=0ToNWind1-1
    WF_I(K)=1#-((K-NWind_1/2#)/(NWind_1/2#))^2
    NextK
    EndSelect
    '
    '
    ' Completo il vettore
    ' con la seconda meta':
    ForK=0ToNWind1-1
    KK=NWind-1-K
    WF_I(KK)=WF_I(K)
    NextK
    '
    WinProf=WF_I()
    '
    '
    '
    EndFunction
    PrivateFunctionI0_Kaiser(ByValXAsDouble,OptionalByRefNAsLong)AsDouble
    '
    '   Calcola e ritorna la funzione di Bessel modificata del primo
    '   tipo e di ordine zero per 0 <= X <= 20.  N e' il numero
    '   di iterazioni impiegate per la convergenza.
    '    Da: Theory and Application of Digital Signal Processing.
    '        L. R. Rabiner, B. Gold   -   pg. 103
    '
    DimY#,e#,de#,SDE#
    Constt#=0.00000001
    '
    Y=X/2#
    e=1#
    de=1#
    ForN=1To25
    de=de*Y/CDbl(N)
    SDE=de^2
    e=e+SDE
    If(0#<(e*t-SDE))Then
    I0_Kaiser=e
    ExitFunction
    EndIf
    NextN
    '
    N=0
    '
    '
    '
    EndFunction
    PublicFunctionWinTipi()AsWindow_Type()
    '
    '   Imposta i parametri dei tipi di
    '"Window" disponibili:
    '    Profilo da File:       WinTipi(0)  -> non usato, in questa applicazione.
    '    Bartlett:              WinTipi(1)
    '    Bartlett-Hann:         WinTipi(2)
    '    Blackman:              WinTipi(3)
    '    Blackman-Harris:       WinTipi(4)
    '    Blackman-Nuttal:       WinTipi(5)
    '    Flat top:              WinTipi(6)
    '    Gauss:                 WinTipi(7)
    '    Hamming generalizzata: WinTipi(8)
    '    Hamming:               WinTipi(9)
    '    Hanning:               WinTipi(10)
    '    Kaiser:                WinTipi(11)
    '    Lanczos:               WinTipi(12)
    '    Nuttal:                WinTipi(13)
    '    Rettangolare:          WinTipi(14)
    '    Triangolare:           WinTipi(15)
    '    Weber:                 WinTipi(16)
    '    Welch:                 WinTipi(17)
    '
    DimI&,WTipi()AsWindow_Type
    '
    I=0
    ReDimWTipi(0ToI)
    WTipi(I).Nome="--> Nome del File"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Bartlett"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Bartlett-Hann"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Blackman"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Blackman-Harris"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Blackman-Nuttal"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Flat top"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Gauss"
    WTipi(I).PMin=0.05
    WTipi(I).PMax=0.5
    WTipi(I).PCor=0.2
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Hamming generalizzata"
    WTipi(I).PMin=0.5
    WTipi(I).PMax=1#
    WTipi(I).PCor=0.5
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Hamming"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Hanning"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Kaiser"
    WTipi(I).PMin=0.5
    WTipi(I).PMax=20#
    WTipi(I).PCor=10#
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Lanczos"
    WTipi(I).PMin=0.5
    WTipi(I).PMax=3.5
    WTipi(I).PCor=1.4
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Nuttal"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Rettangolare"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Triangolare"
    WTipi(I).PMin=-1
    WTipi(I).PMax=-1
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Weber"
    WTipi(I).PMin=0.5
    WTipi(I).PMax=1#
    WTipi(I).PCor=1#
    '
    I=I+1
    ReDimPreserveWTipi(0ToI)
    WTipi(I).Nome="Welch"
    WTipi(I).PMin=0.5
    WTipi(I).PMax=-1
    WTipi(I).PCor=-1
    '
    WinTipi=WTipi()
    '
    '
    '
    EndFunction
    PublicSubSFFTBF(ByValNAsLong,d()AsDouble,_
    ByRefRe()AsDouble,ByRefIm()AsDouble,ByValNFREAsLong)
    '
    '   SFFTBF(D, N, MM, S1, C1, S3, C3, ITAB)
    '
    '   A real-valued, in place, split-radix FFT program
    '   Real input and output in data array D
    '   Length is N = 2 ** MM
    '   Decimation-in-time, cos/sin in second loop with table look-up
    '   Output in order:
    '    [ Re(0), Re(1), ..., Re(N/2), Im(N/2-1), ..., Im(1) ]
    '
    '    S1 - array of sin() table (length >= N/8-1)
    '    C1 - array of cos() table (length >= N/8-1)
    '    S3 - array of sin() table (length >= N/8-1)
    '    C3 - array of cos() table (length >= N/8-1)
    '    ITAB - integer bit reversal table (length >= sqrt(2n) )
    '
    '   The initialization routine SFFTBI must be called prior to calling
    '   this routine.  SFFTBI need not be called again unless N changes.
    '
    '   Original code (RVFFT) written by H.V. Sorensen,
    '                                    Rice University, Oct. 1985
    '
    '   Modifications made by Steve Kifowit, 26 June 1997
    '    -- table look-up of sines and cosines
    '    -- incorporation of bit reversal table
    '    -- quick return
    '
    '   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
    '
    '   Entra con:
    '       N     = Numero max. di dati in D() da usare.
    '       D()   = Vettore dei valori Reali del Segnale(t).
    '       NFRE  = Numero dei valori di Frequenza da calcolare.
    '
    '   Esce  con:
    '       Re()  = Vettore dei valori Reali      della Trasformata(f).
    '       Im()  = Vettore dei valori Immaginari della Trasformata(f).
    '
    '   I valori della trasformata in Re(), Im() NON vengono
    '   normalizzati sulla lunghezza del Segnale 2^MM.
    '
    '   Gli N dati nel vettore D() sono organizzati come D(0 To N - 1);
    '   gli NFre_C + 1 dati nei vettori Re() e Im() sono organizzati come
    '   Vettore(0 To NFre).
    '
    '   Ver: 27/10/2006.
    '
    DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
    DimN1&,N2&,N4&,N8&,NN&,It&
    DimXT#,R1#,t1#,T2#,T3#,T4#,T5#,T6#
    DimCC1#,SS1#,CC3#,SS3#,NFreq#
    '
    If(N=1)ThenExitSub
    '
    ' Sposto i dati di ingresso nel vettore D1() per non distruggerli
    ' e per avere un vettore a base 1 come richiesto da questa routine:
    CopyMemoryD1(1),d(0),8*N
    '
    N1=ITAB(1)
    ForK=2ToN1
    I0=N1*ITAB(K)+1
    I=K
    J=I0
    ForIt=2ToITAB(K)+1
    XT=D1(I)
    D1(I)=D1(J)
    D1(J)=XT
    I=I+N1
    J=I0+ITAB(It)
    NextIt
    NextK
    '
    Ic=1
    ID=4
    70
    ForI0=IcToNStepID
    I1=I0+1
    R1=D1(I0)
    D1(I0)=R1+D1(I1)
    D1(I1)=R1-D1(I1)
    NextI0
    Ic=2*ID-1
    ID=4*ID
    If(Ic<N)ThenGoTo70
    '
    N2=2
    NN=N/2
    ForK=2ToMM
    N2=N2*2
    N4=N2/4
    N8=N2/8
    NN=NN/2
    Ic=0
    ID=N2*2
    40
    ForI=IcToN-1StepID
    I1=I+1
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    t1=D1(I4)+D1(I3)
    D1(I4)=D1(I4)-D1(I3)
    D1(I3)=D1(I1)-t1
    D1(I1)=D1(I1)+t1
    If(N4=1)ThenGoTo38
    I1=I1+N8
    I2=I2+N8
    I3=I3+N8
    I4=I4+N8
    t1=(D1(I3)+D1(I4))/Sqr2
    T2=(D1(I3)-D1(I4))/Sqr2
    D1(I4)=D1(I2)-t1
    D1(I3)=-D1(I2)-t1
    D1(I2)=D1(I1)-T2
    D1(I1)=D1(I1)+T2
    38'CONTINUE
    NextI
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N)ThenGoTo40
    ForJ=2ToN8
    It=(J-1)*NN
    CC1=C1(It)
    SS1=S1(It)
    CC3=C3(It)
    SS3=S3(It)
    Ic=0
    ID=2*N2
    36
    ForI=IcToN-1StepID
    I1=I+J
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    I5=I+N4-J+2
    I6=I5+N4
    I7=I6+N4
    I8=I7+N4
    t1=D1(I3)*CC1+D1(I7)*SS1
    T2=D1(I7)*CC1-D1(I3)*SS1
    T3=D1(I4)*CC3+D1(I8)*SS3
    T4=D1(I8)*CC3-D1(I4)*SS3
    T5=t1+T3
    T6=T2+T4
    T3=t1-T3
    T4=T2-T4
    T2=D1(I6)+T6
    D1(I3)=T6-D1(I6)
    D1(I8)=T2
    T2=D1(I2)-T3
    D1(I7)=-D1(I2)-T3
    D1(I4)=T2
    t1=D1(I1)+T5
    D1(I6)=D1(I1)-T5
    D1(I1)=t1
    t1=D1(I5)+T4
    D1(I5)=D1(I5)-T4
    D1(I2)=t1
    NextI
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N)ThenGoTo36
    NextJ
    NextK
    '
    ' Sistemo i valori calcolati in D1()
    ' nei vettori Re(), Im():
    'For I = 0 To NFre
    '    Re(I) = D1(I + 1)
    'Next I
    CopyMemoryRe(0),D1(1),8*(NFRE+1)
    '
    ForI=1ToNFRE-1
    Im(I)=D1(N-I+1)
    NextI
    '
    '   ... End of subroutine SFFTBF ...
    '
    EndSub
    PublicSubSFFTBF_Corr(d()AsDouble,ByRefRe_C()AsDouble,ByRefIm_C()AsDouble)
    '
    '   SFFTBF(D, N_C, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C)
    '
    '   A real-valued, in place, split-radix FFT program
    '   Real input and output in data array D
    '   Length is N_C = 2 ** MM_C
    '   Decimation-in-time, cos/sin in second loop with table look-up
    '   Output in order:
    '    [ Re_C(0), Re_C(1), ..., Re_C(N_C/2), Im_C(N_C/2-1), ..., Im_C(1) ]
    '
    '    S1_C   - array of sin() table (length >= N_C/8-1)
    '    C1_C   - array of cos() table (length >= N_C/8-1)
    '    S3_C   - array of sin() table (length >= N_C/8-1)
    '    C3_C   - array of cos() table (length >= N_C/8-1)
    '    ITAB_C - integer bit reversal table (length >= sqrt(2n) )
    '
    '   The initialization routine SFFTBI_Corr must be called prior to calling
    '   this routine.  SFFTBI_Corr need not be called again unless N1_C or
    '   N2_C change.
    '
    '   Original code (RVFFT) written by H.V. Sorensen,
    '                                    Rice University, Oct. 1985
    '
    '   Modifications made by Steve Kifowit, 26 June 1997
    '    -- table look-up of sines and cosines
    '    -- incorporation of bit reversal table
    '    -- quick return
    '
    '   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
    '
    '   Entra con:
    '       N_C     = Numero max. di dati in D() da usare.
    '       D()     = Vettore dei valori Reali del Segnale(t).
    '       NFre_C  = Numero dei valori di Frequenza da calcolare.
    '
    '   Esce  con:
    '       Re_C()  = Vettore dei valori Reali      della Trasformata(f).
    '       Im_C()  = Vettore dei valori Immaginari della Trasformata(f).
    '
    '   I valori della trasformata in Re_C(), Im_C() NON vengono
    '   normalizzati sulla lunghezza del Segnale 2^MM_C.
    '
    '   Gli N_C dati nel vettore D() sono organizzati come D(0 To N_C - 1);
    '   gli NFre_C + 1 dati nei vettori Re_C() e Im_C() sono organizzati come
    '   Vettore(0 To NFre_C).
    '
    '   Ver: 22/05/2007 per MAutoCorr_FT e MMutuaCorr_FT.
    '
    DimJ&,I&,K&,Ic&,ID&,I0&,I1&,I2&,I3&,I4&,I5&,I6&,I7&,I8&
    DimN1&,N2&,N4&,N8&,NN&,It&
    DimXT#,R1#,t1#,T2#,T3#,T4#,T5#,T6#
    DimCC1#,SS1#,CC3#,SS3#,NFreq#
    '
    If(N_C=1)ThenExitSub
    '
    ' Sposto i dati di ingresso nel vettore D1_C() per non distruggerli
    ' e per avere un vettore a base 1 come richiesto da questa routine:
    CopyMemoryD1_C(1),d(0),8*N_C
    '
    N1=ITAB_C(1)
    ForK=2ToN1
    I0=N1*ITAB_C(K)+1
    I=K
    J=I0
    ForIt=2ToITAB_C(K)+1
    XT=D1_C(I)
    D1_C(I)=D1_C(J)
    D1_C(J)=XT
    I=I+N1
    J=I0+ITAB_C(It)
    NextIt
    NextK
    '
    Ic=1
    ID=4
    70
    ForI0=IcToN_CStepID
    I1=I0+1
    R1=D1_C(I0)
    D1_C(I0)=R1+D1_C(I1)
    D1_C(I1)=R1-D1_C(I1)
    NextI0
    '
    Ic=2*ID-1
    ID=4*ID
    If(Ic<N_C)ThenGoTo70
    '
    N2=2
    NN=N_C/2
    ForK=2ToMM_C
    N2=N2*2
    N4=N2/4
    N8=N2/8
    NN=NN/2
    Ic=0
    ID=N2*2
    40
    ForI=IcToN_C-1StepID
    I1=I+1
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    t1=D1_C(I4)+D1_C(I3)
    D1_C(I4)=D1_C(I4)-D1_C(I3)
    D1_C(I3)=D1_C(I1)-t1
    D1_C(I1)=D1_C(I1)+t1
    If(N4=1)ThenGoTo38
    I1=I1+N8
    I2=I2+N8
    I3=I3+N8
    I4=I4+N8
    t1=(D1_C(I3)+D1_C(I4))/Sqr2
    T2=(D1_C(I3)-D1_C(I4))/Sqr2
    D1_C(I4)=D1_C(I2)-t1
    D1_C(I3)=-D1_C(I2)-t1
    D1_C(I2)=D1_C(I1)-T2
    D1_C(I1)=D1_C(I1)+T2
    38'CONTINUE
    NextI
    '
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N_C)ThenGoTo40
    '
    ForJ=2ToN8
    It=(J-1)*NN
    CC1=C1_C(It)
    SS1=S1_C(It)
    CC3=C3_C(It)
    SS3=S3_C(It)
    Ic=0
    ID=2*N2
    36
    ForI=IcToN_C-1StepID
    I1=I+J
    I2=I1+N4
    I3=I2+N4
    I4=I3+N4
    I5=I+N4-J+2
    I6=I5+N4
    I7=I6+N4
    I8=I7+N4
    t1=D1_C(I3)*CC1+D1_C(I7)*SS1
    T2=D1_C(I7)*CC1-D1_C(I3)*SS1
    T3=D1_C(I4)*CC3+D1_C(I8)*SS3
    T4=D1_C(I8)*CC3-D1_C(I4)*SS3
    T5=t1+T3
    T6=T2+T4
    T3=t1-T3
    T4=T2-T4
    T2=D1_C(I6)+T6
    D1_C(I3)=T6-D1_C(I6)
    D1_C(I8)=T2
    T2=D1_C(I2)-T3
    D1_C(I7)=-D1_C(I2)-T3
    D1_C(I4)=T2
    t1=D1_C(I1)+T5
    D1_C(I6)=D1_C(I1)-T5
    D1_C(I1)=t1
    t1=D1_C(I5)+T4
    D1_C(I5)=D1_C(I5)-T4
    D1_C(I2)=t1
    NextI
    '
    Ic=2*ID-N2
    ID=4*ID
    If(Ic<N_C)ThenGoTo36
    NextJ
    NextK
    '
    ' Sistemo i valori calcolati in D1_C()
    ' nei vettori Re_C(), Im_C():
    '    For I = 0 To NFre_C - 1
    '        Re_C(I) = D1_C(I + 1)
    '    Next I
    CopyMemoryRe_C(0),D1_C(1),8*(NFre_C+1)
    '
    ForI=1ToNFre_C-1
    Im_C(I)=D1_C(N_C-I+1)
    NextI
    '
    '   ... End of subroutine SFFTBF ...
    '
    EndSub
    PublicSubSFFTBI(ByValNAsLong)
    '
    '   SFFTBI( N, MM, S1, C1, S3, C3, ITAB )
    '
    '   Table initialization routine for SFFTBF and SFFTBB
    '
    '   Usage: CALL SFFTBI( N, MM, S1, C1, S3, C3, ITAB )
    '   Parameters:
    '    N - integer length of transform (must be a power of two)
    '    MM - integer such that N = 2**MM
    '    S1 - array of sin() table (length >= n/8-1)
    '    C1 - array of cos() table (length >= n/8-1)
    '    S3 - array of sin() table (length >= n/8-1)
    '    C3 - array of cos() table (length >= n/8-1)
    '    ITAB - integer bit reversal table (length >= sqrt(2n))
    '
    '   Uses standard FORTRAN programs - sin, cos
    '
    '   Steve Kifowit, 26 June 1997
    '
    '   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
    '
    '   I valori calcolati nei vettori S1(), C1(), S3(), C3() e ITAB() ed MM
    '   non vengono ritornati da questa routine ma memorizzati localmente
    '   per essere, successivamente, usati da SFFTBF.
    '
    '
    '
    DimI&,K&,IMax&,M2&,MS&
    DimANG#,t#,u#
    '
    ReDimS1(1ToN/8-1),C1(1ToN/8-1)
    ReDimS3(1ToN/8-1),C3(1ToN/8-1)
    ReDimITAB(1ToSqr(2*N))
    ReDimD1(1ToN)
    '
    MM=CLng(Log(CDbl(N))/Log2)
    '
    '   ... Compute bit reversal table ...
    M2=Int(MM/2)
    MS=2^M2
    If(2*M2<>MM)ThenM2=M2+1
    ITAB(1)=0
    ITAB(2)=1
    IMax=1
    ForK=2ToM2
    IMax=2*IMax
    ForI=1ToIMax
    ITAB(I)=2*ITAB(I)
    ITAB(I+IMax)=1+ITAB(I)
    NextI
    NextK
    ITAB(1)=MS
    '
    '   ... Quick return ...
    If(N<=8)ThenExitSub
    '
    '   ... Compute trig tables ...
    ANG=PI2/CDbl(N)
    K=N/8-1
    ForI=1ToK
    t=ANG*CDbl(I)
    C1(I)=Cos(t)
    S1(I)=Sin(t)
    u=3#*t
    C3(I)=Cos(u)
    S3(I)=Sin(u)
    NextI
    '
    '   ... End of subroutine SFFTBI ...
    '
    EndSub
    PublicSubSFFTBI_Corr(ByValN1AsLong,OptionalByValN2AsLong=-1)
    '
    '   SFFTBI( N, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C )
    '
    '   Table initialization routine for SFFTBF_Corr and SFFTBB_Corr
    '
    '   Usage: CALL SFFTBI( N, MM_C, S1_C, C1_C, S3_C, C3_C, ITAB_C )
    '   Parameters:
    '    N1     - integer length of 1° data vector.
    '    N2     - integer length of 2° data vector.
    '    N_C    - integer length of transform (is a power of two).
    '    MM_C   - integer such that N_C = 2**MM_C.
    '    S1_C   - array of sin() table (length >= n/8-1).
    '    C1_C   - array of cos() table (length >= n/8-1).
    '    S3_C   - array of sin() table (length >= n/8-1).
    '    C3_C   - array of cos() table (length >= n/8-1).
    '    ITAB_C - integer bit reversal table (length >= sqrt(2n)).
    '
    '   Uses standard FORTRAN programs - sin, cos
    '
    '   Steve Kifowit, 26 June 1997
    '
    '   Tradotta dal FORTRAN e modificata da F. Languasco 25/08/2005.
    '
    '   I valori calcolati nei vettori S1_C(), C1_C(), S3_C(), C3_C(), ITAB_C()
    '   e nelle variabili N_C, MM_C non vengono ritornati da questa routine ma
    '   memorizzati localmente per essere, successivamente, usati da SFFTBF_Corr
    '   e SFFTBB_Corr.
    '
    '   Versione per AudioCardDSP (22/05/2007) da usare con MAutoCorr_FT
    '   e MMutuaCorr_FT.
    '
    DimI&,K&,IMax&,M2&,MS&
    DimOmSh#,ANG#,t#,u#
    '
    N1_C=N1
    If(N2=-1)Then
    N2_C=N1
    Else
    N2_C=N2
    EndIf
    '
    MM_C=CLng(Ceil(Log(CDbl(N1_C+N2_C-1))/Log2))
    N_C=2^MM_C
    NFre_C=N_C/2
    '
    ReDimS1_C(1ToN_C/8-1),C1_C(1ToN_C/8-1)
    ReDimS3_C(1ToN_C/8-1),C3_C(1ToN_C/8-1)
    ReDimITAB_C(1ToSqr(2*N_C))
    ReDimD1_C(1ToN_C)
    ReDimRe1_C(0ToNFre_C),Im1_C(0ToNFre_C)
    ReDimRe2_C(0ToNFre_C),Im2_C(0ToNFre_C)
    ReDims(0ToNFre_C),f(0ToNFre_C)
    ReDimWnRe(0ToNFre_C),WnIm(0ToNFre_C)
    '
    ' Calcolo le tavole dei seni/coseni per
    ' la trasformata del segnale ritardato
    ' di N1_C campioni (solo per AutoCorr_FT):
    OmSh=PI2*N1_C/N_C
    ForI=0ToNFre_C
    WnRe(I)=Cos(OmSh*I)
    WnIm(I)=-Sin(OmSh*I)
    NextI
    '
    '   ... Compute bit reversal table ...
    M2=Int(MM_C/2)
    MS=2^M2
    If(2*M2<>MM_C)ThenM2=M2+1
    ITAB_C(1)=0
    ITAB_C(2)=1
    IMax=1
    ForK=2ToM2
    IMax=2*IMax
    ForI=1ToIMax
    ITAB_C(I)=2*ITAB_C(I)
    ITAB_C(I+IMax)=1+ITAB_C(I)
    NextI
    NextK
    ITAB_C(1)=MS
    '
    '   ... Quick return ...
    If(N_C<=8)ThenExitSub
    '
    '   ... Compute trig tables ...
    ANG=PI2/CDbl(N_C)
    K=N_C/8-1
    ForI=1ToK
    t=ANG*CDbl(I)
    C1_C(I)=Cos(t)
    S1_C(I)=Sin(t)
    u=3#*t
    C3_C(I)=Cos(u)
    S3_C(I)=Sin(u)
    NextI
    '
    '   ... End of subroutine SFFTBI ...
    '
    EndSub

    PublicSubLeggiCoefficienti_IIR(ByRefNK_UAsLong,ByRefNCel_UAsLong,_
    ByRefW_U()AsSingle,ByRefAc_U()AsSingle,ByRefBc_U()AsSingle)
    '
    '   Con questa routine e' possibile ritornare, per uso locale, i
    '   coefficienti di un filtro IIR calcolati precedentemente dalla
    '   Function SintesiIIR_BT():
    '
    '   Routine usata in AudioCardDSP (27/04/2009)
    '
    NK_U=NK' Ordine
    NCel_U=NCel' e numero di sezioni del filtro.
    W_U()=w()' Registri delle sezioni del filtro.
    Ac_U()=Ac()' Coefficienti del filtro.
    Bc_U()=Bc()'"""
    '
    '
    '
    EndSub
    PublicSubLeggiCoefficienti_SPM_R(ByRefSn_1_UAsComplex,ByRefSmRE_U()AsDouble,_
    ByRefz1_1_UAsComplex,ByRefz1_N_UAsComplex,ByRefNormSpm_UAsDouble)
    '
    '   Con questa routine e' possibile ritornare, per uso locale, i
    '   coefficienti di un filtro SPM_R calcolati precedentemente dalla
    '   Sub SPM_MF_R_Init():
    '
    '   Routine usata in AudioCardDSP (27/04/2009)
    '
    Sn_1_U=Sn_1' Sn * Z^-1
    SmRE_U()=SmRE()' Registro a scorrimento dei campioni del segnale.
    z1_1_U=z1_1' z1(0)^-1
    z1_N_U=z1_N' z1(0)^-N
    NormSpm_U=NormSpm' Fattore di normalizzazione sul N° di campioni.
    '
    '
    '
    EndSub
    ↧

    ProcCounters & ProcMonitor - instrument your application

    July 21, 2021, 10:58 am
    $
    0
    0


    An issue many of us deal with is trying different approaches in an application in order to improve performance. Often enough these are big changes, for example ADO Client vs. Server cursor location or using a file vs. keeping everything in memory.


    Download from VBForums
    Download from ME

    So you don't need a code profiler right off the bat to micro-optimize, instead you need more "global" performance numbers: accumulating counters for the process. There are some API calls to retrieve a number of statistics. Some of the more useful ones measure CPU use, I/O use, and memory use.


    ProcCounters is a VB6 class wrapping several of these calls. ProcMonitor is a VB6 UserControl that displays summary information you can watch while running your program. It samples statistics via ProcCounters and shows them in abbreviated format. The test program in the attachment just does a bunch of grinding away while it logs ProcCounters results and has a ProcMonitor (blue here) running as well. These require Windows 2000 or later. Note that ProcMonitor uses SHLWAPI calls to format byte-count values in "base 2" scales, i.e. 1KB = 1024 bytes, etc.


    Source:
    http://earlier189.rssing.com/browser.php?indx=6373759&item=371
    ↧
    ↧

    CryptoAPI encryption/Decryption, hashing, and random number generation (by Kenneth Ives)

    July 31, 2021, 2:02 pm
    $
    0
    0
    Demonstration of CryptoAPI encryption/Decryption, hashing, and random number generation. Encryption includes RC2, RC4, DES, DES3, AES-128, AES-192, AES-256. Hashing includes MD4, MD5, SHA-1, SHA-256, SHA-384, SHA-512. Windows XP SP2 or earlier no longer supported. Updated 20-Jul-2017, support modules and documentation.

    Download from ME
    Download from PSC







    Count Lines of Code v2.0.353                             22 Mar 2017  06:29 AM

                                  CryptoAPI_Group.vbg
                            Kenneth Ives  kenaso@tx.rr.com
    ------------------------------------------------------------------------------

       VBG Name:  C:\Kens Software\CryptoAPI\CryptoAPI_Group.vbg

       VBP Name:  C:\Kens Software\CryptoAPI\CryptoAPIDemo.vbp

    Module Name:  C:\Kens Software\CryptoAPI\clsKeyEdit.cls

                      10  Sub routines
                      80  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                      60  Blank lines (** Not included in totals **)
                     287  Comment lines (** Not included in totals **)
              ----------
                      90  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\clsManifest.cls

                       3  Constant variables
                       1  Enum Structures
                       1  Type Structures
                       5  API Declare statements
                       4  Property Let routines
                       2  Sub routines
                       4  Functions
                     182  Miscellaneous lines of code
                      13  Auto generated lines (** Not included in totals **)
                      88  Blank lines (** Not included in totals **)
                     289  Comment lines (** Not included in totals **)
              ----------
                     198  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\clsOperSystem.cls

                     105  Constant variables
                       1  Type Structures
                       6  API Declare statements
                     163  Property Get routines
                      13  Sub routines
                   1,170  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                     381  Blank lines (** Not included in totals **)
                     378  Comment lines (** Not included in totals **)
              ----------
                   1,295  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\clsPrivileges.cls

                      11  Constant variables
                       3  Type Structures
                       6  API Declare statements
                       4  Property Let routines
                       1  Property Get routines
                       3  Sub routines
                       3  Functions
                     173  Miscellaneous lines of code
                      13  Auto generated lines (** Not included in totals **)
                     117  Blank lines (** Not included in totals **)
                     213  Comment lines (** Not included in totals **)
              ----------
                     199  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\frmAbout.frm

                       7  Constant variables
                       3  API Declare statements
                       9  Sub routines
                      95  Miscellaneous lines of code
                     332  Auto generated lines (** Not included in totals **)
                      23  Blank lines (** Not included in totals **)
                      84  Comment lines (** Not included in totals **)
              ----------
                     114  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\frmMain.frm

                       6  Constant variables
                       2  API Declare statements
                      37  Sub routines
                   1,340  Miscellaneous lines of code
                     779  Auto generated lines (** Not included in totals **)
                      93  Blank lines (** Not included in totals **)
                     258  Comment lines (** Not included in totals **)
              ----------
                   1,385  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\frmSplash.frm

                       2  Sub routines
                      10  Miscellaneous lines of code
                      52  Auto generated lines (** Not included in totals **)
                       6  Blank lines (** Not included in totals **)
                      17  Comment lines (** Not included in totals **)
              ----------
                      12  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modCentering.bas

                      12  Constant variables
                       1  Type Structures
                       7  API Declare statements
                       2  Sub routines
                       3  Functions
                      83  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                      73  Blank lines (** Not included in totals **)
                     207  Comment lines (** Not included in totals **)
              ----------
                     108  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modCommon.bas

                       5  Constant variables
                       5  Functions
                      79  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                      50  Blank lines (** Not included in totals **)
                      99  Comment lines (** Not included in totals **)
              ----------
                      89  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modDialogBox.bas

                      61  Constant variables
                       7  Type Structures
                      24  API Declare statements
                       6  Sub routines
                      11  Functions
                     652  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                     105  Blank lines (** Not included in totals **)
                     770  Comment lines (** Not included in totals **)
              ----------
                     761  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modMain.bas

                      34  Constant variables
                       1  Type Structures
                      23  API Declare statements
                       8  Sub routines
                      11  Functions
                     340  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                     244  Blank lines (** Not included in totals **)
                     654  Comment lines (** Not included in totals **)
              ----------
                     417  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modMessages.bas

                      24  Constant variables
                       2  Enum Structures
                       1  Type Structures
                       9  API Declare statements
                       4  Sub routines
                       4  Functions
                     101  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                      79  Blank lines (** Not included in totals **)
                     405  Comment lines (** Not included in totals **)
              ----------
                     145  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modProcesses.bas

                       9  Constant variables
                       1  Type Structures
                      16  API Declare statements
                       2  Sub routines
                      13  Functions
                     265  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                     199  Blank lines (** Not included in totals **)
                     398  Comment lines (** Not included in totals **)
              ----------
                     306  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\modTrimStr.bas

                       1  Constant variables
                       1  Type Structures
                       2  API Declare statements
                       2  Functions
                      53  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                      33  Blank lines (** Not included in totals **)
                     129  Comment lines (** Not included in totals **)
              ----------
                      59  Module lines of code

              ----------
                   5,178  Sub-total for project
                         

       VBP Name:  C:\Kens Software\CryptoAPI\DLL\kiCryptoAPI.vbp

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsAPI_Hash.cls

                      39  Constant variables
                       1  Enum Structures
                       7  API Declare statements
                       5  Property Let routines
                       2  Property Get routines
                       1  Event routines
                       6  Sub routines
                       7  Functions
                     320  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                     204  Blank lines (** Not included in totals **)
                     554  Comment lines (** Not included in totals **)
              ----------
                     381  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsBigFiles.cls

                      19  Constant variables
                      10  API Declare statements
                       2  Property Let routines
                       2  Event routines
                       4  Sub routines
                      13  Functions
                     351  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                     230  Blank lines (** Not included in totals **)
                     704  Comment lines (** Not included in totals **)
              ----------
                     399  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsCRC32.cls

                       8  Constant variables
                       1  Property Let routines
                       2  Property Get routines
                       1  Event routines
                       3  Sub routines
                       4  Functions
                     202  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                      56  Blank lines (** Not included in totals **)
                     189  Comment lines (** Not included in totals **)
              ----------
                     218  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsCipher.cls

                       7  Constant variables
                       7  Property Let routines
                       5  Property Get routines
                       1  Event routines
                       3  Sub routines
                       4  Functions
                     324  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                      63  Blank lines (** Not included in totals **)
                      98  Comment lines (** Not included in totals **)
              ----------
                     339  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsCryptoAPI.cls

                      73  Constant variables
                       2  Enum Structures
                      13  API Declare statements
                       7  Property Let routines
                       3  Property Get routines
                       2  Event routines
                       5  Sub routines
                      11  Functions
                     708  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                     376  Blank lines (** Not included in totals **)
                     654  Comment lines (** Not included in totals **)
              ----------
                     814  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsHash.cls

                       1  Constant variables
                       4  Property Let routines
                       2  Property Get routines
                       1  Event routines
                       3  Sub routines
                       2  Functions
                     128  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                      38  Blank lines (** Not included in totals **)
                     117  Comment lines (** Not included in totals **)
              ----------
                     135  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\clsRandom.cls

                      71  Constant variables
                       3  Enum Structures
                      14  API Declare statements
                       2  Property Let routines
                       2  Property Get routines
                      13  Sub routines
                      19  Functions
                     918  Miscellaneous lines of code
                      15  Auto generated lines (** Not included in totals **)
                     502  Blank lines (** Not included in totals **)
                   1,391  Comment lines (** Not included in totals **)
              ----------
                   1,038  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\modCommon.bas

                      18  Constant variables
                       7  API Declare statements
                       3  Sub routines
                      18  Functions
                     232  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                     172  Blank lines (** Not included in totals **)
                     544  Comment lines (** Not included in totals **)
              ----------
                     278  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\modMessages.bas

                      24  Constant variables
                       2  Enum Structures
                       1  Type Structures
                       9  API Declare statements
                       4  Sub routines
                       4  Functions
                     101  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                      79  Blank lines (** Not included in totals **)
                     405  Comment lines (** Not included in totals **)
              ----------
                     145  Module lines of code

    Module Name:  C:\Kens Software\CryptoAPI\DLL\modTrimStr.bas

                       1  Constant variables
                       1  Type Structures
                       2  API Declare statements
                       2  Functions
                      53  Miscellaneous lines of code
                       1  Auto generated lines (** Not included in totals **)
                      33  Blank lines (** Not included in totals **)
                     129  Comment lines (** Not included in totals **)
              ----------
                      59  Module lines of code

              ----------
                   3,806  Sub-total for project
                         

              ==========
                   8,984  Total number of lines of code

    ******************************************************************************
    NOTE:     Visual Basic trailers are not counted.  These are the
              logical ending statements used by proceedural headings.

                   End Sub     End Function     End Property
                   End If      End Type         Loop
                   Next        Wend             End With
                   End Select
    ******************************************************************************

    kiCryptoAPI.dll Kenneth Ives (kenaso|at|tx.rr.com)
    I am open to ways to improve this application, please email me.
    Visual Basic 6.0 with Service Pack 6 runtime files required.
    To obtain required files (VBRun60sp6.exe):
    http://www.microsoft.com/downloads/details.aspx?FamilyId=7B9BA261-7A9C-43E7-9117-F6730
    77FFB3C
    VBRun60sp6.exe installs Visual Basic 6.0 SP6 run-time files.
    http://support.microsoft.com/kb/290887
    This software has been tested on Windows XP SP3 64-bit through Windows 10.
    Windows XP 32-bit, 9x, 2000 and NT4 are no longer supported.
    *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
    *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    You acknowledge that this software is subject to the export control
    laws and regulations of the United States ("U.S.") and agree to abide
    by those laws and regulations. Under U.S. law, this software may not
    be downloaded or otherwise exported, reexported, or transferred to
    restricted countries, restricted end-users, or for restricted
    end-uses. The U.S. currently has embargo restrictions against Cuba,
    Iran, Iraq, Libya, North Korea, Sudan, and Syria. The lists of
    restricted end-users are maintained on the U.S. Commerce Department's
    Denied Persons List, the Commerce Department's Entity List, the
    Commerce Department's List of Unverified Persons, and the U.S.
    Treasury Department's List of Specially Designated Nationals and
    Blocked Persons. In addition, this software may not be downloaded or
    otherwise exported, reexported, or transferred to an end-user engaged
    in activities related to weapons of mass destruction.
    *=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
    REFERENCE:
    The Cryptography API, or How to Keep a Secret
    http://msdn.microsoft.com/en-us/library/ms867086.aspx
    CryptoAPI Cryptographic Service Providers
    http://msdn.microsoft.com/en-us/library/bb931357(VS.85).aspx
    SHA-2 support on MS Windows
    Paraphrasing: Regarding SHA-224 support, SHA-224 offers less security
    than SHA-256 but takes the same amount of resources. Also SHA-224 is
    not generally used by protocols and applications. The NSA's (National
    Security Agency) Suite B standards also does not include it. Microsoft
    has no plans to add it to future versions of their Cryptographic
    Service Providers (CSP).
    http://blogs.msdn.com/b/alejacma/archive/2009/01/23/sha-2-support-on-windows-xp.aspx
    NIST (National Institute of Standards and Technology)
    FIPS (Federal Information Processing Standards Publication)
    SP (Special Publications)
    http://csrc.nist.gov/publications/PubsFIPS.html
    FIPS 180-2 (Federal Information Processing Standards Publication)
    dated 1-Aug-2002, with Change Notice 1, dated 25-Feb-2004
    http://csrc.nist.gov/publications/fips/fips180-2/FIPS180-2_changenotice.pdf
    FIPS 180-3 (Federal Information Processing Standards Publication)

    dated Oct-2008 (supercedes FIPS 180-2)
    http://csrc.nist.gov/publications/fips/fips180-3/fips180-3_final.pdf
    FIPS 180-4 (Federal Information Processing Standards Publication)
    dated Mar-2012 (Supercedes FIPS-180-3)
    http://csrc.nist.gov/publications/fips/fips180-4/fips-180-4.pdf
    Examples of the implementation of the secure hash algorithms
    SHA-1, SHA-224, SHA-256, SHA-384, SHA-512, SHA-512/224 and
    SHA-512/256, can be found at:
    http://csrc.nist.gov/groups/ST/toolkit/examples.html
    http://csrc.nist.gov/groups/ST/toolkit/documents/Examples/SHA2_Additional.pdf
    Aaron Gifford's additional test vectors
    http://www.adg.us/computers/sha.html
    Guidelines for Media Sanitization (SP800-88)
    http://csrc.nist.gov/publications/nistpubs/800-88/NISTSP800-88_rev1.pdf
    WARNING:
    MD4 Message-Digest Algorithm has been compromised at the rump
    session of Crypto 2004 it was announced that Xiaoyun Wang,
    Dengguo Feng, Xuejia Lai and Hongbo Yu found collisions for
    MD4, MD5, RIPEMD, and the 128-bit version of HAVAL.
    http://eprint.iacr.org/2004/199.pdf
    Feb-2005: SHA-1 has been compromised. Recommended that
    you do not use for password or document authentication.
    http://www.schneier.com/blog/archives/2005/02/sha1_broken.html
    http://csrc.nist.gov/groups/ST/toolkit/documents/shs/NISTHashComments-final.pdf
    Mar-2005 Demonstrating a technique for finding MD5 collisions quickly.
    Eight hours on 1.6 GHz computer.
    http://cryptography.hyperlink.cz/md5/MD5_collisions.pdf
    Jun-2005 Two researchers from the Institute for Cryptology and
    IT-Security have generated PostScript files with identical MD5-sums
    but entirely different (but meaningful!) content.
    http://www.schneier.com/blog/archives/2005/06/more_md5_collis.html
    March 15, 2006: The SHA-2 family of hash functions
    (i.e., SHA-224, SHA-256, SHA-384 and SHA-512) may be used
    by Federal agencies for all applications using secure hash
    algorithms. Federal agencies should stop using SHA-1 for
    digital signatures, digital time stamping and other
    applications that require collision resistance as soon as
    practical, and must use the SHA-2 family of hash functions
    for these applications after 2010. After 2010, Federal
    agencies may use SHA-1 only for the following applications:
    - hash-based message authentication codes (HMACs)
    - key derivation functions (KDFs)
    - random number generators (RNGs)
    Regardless of use, NIST encourages application and protocol
    designers to use the SHA-2 family of hash functions for all
    new applications and protocols.
    http://csrc.nist.gov/groups/ST/hash/policy.html

    Export Control: Certain cryptographic devices and technical
    data regarding them are subject to Federal export controls.
    Exports of cryptographic modules implementing this standard
    and technical data regarding them must comply with these
    Federal regulations and be licensed by the Bureau of Export
    Administration of the U.S. Department of Commerce.

    Information about export regulations is available at:
    http://www.bis.doc.gov/index.htm
    *****************************************************************************
    How to use:
    For a simple example, execute the SHA_Demo application. The demo converts
    the data to a byte array prior to passing it to the DLL to be hashed.
    [STRING DATA]
    Convert string data to byte array prior to passing to the HashString function.
    Ex: abytData() = StrConv("abc", vbFromUnicode)
    [FILE DATA]
    Just the path and filename are passed in the byte array. Convert the
    path\filename data to byte array prior to passing to the HashFile function.
    The HashFile routine will open and read the file into an internal byte array.
    Ex: abytData() = StrConv("C:\Files\Test Folder\Testfile.txt", vbFromUnicode)
    Both will create a hashed output string based on file data input.
    -------------------------------------------------------------------------------
    Test data provided to test either hash or cipher:
    TestPhrase.txt ASCII text phrase (Copy & paste phrase for string test)
    TestFile.txt ASCII text file
    Binary test files:
    kB_32.dat 32,768 binary zeros
    OneMil_0.dat One million binary zeros (FIPS 180-3)
    OneMil_a.dat One million letter "a" (FIPS 180-2)
    API32.txt Text file over 1 MB
    *****************************************************************************
    Note from Mark Hutchinson's presentation about Microsoft's VB random number
    generator. http://www.15seconds.com/issue/051110.htm
    References:
    Randomize Statement Doesn't Re-initialize Rnd Function
    http://support.microsoft.com/default.aspx?scid=kb;en-us;120587
    "To re-initialize the random-number generator, use the Rnd function with a
    value of -1 to re-initialize the Rnd function, and then use the Randomize
    statement with the value you want to use as the seed value for the Rnd
    function."

    VBA's Pseudo Random Number Generator
    http://www.noesis.net.au/prng.php
    INFO: How Visual Basic Generates Pseudo-Random Numbers for the RND Function
    http://support.microsoft.com/kb/231847/en-us
    RND and RANDOMIZE Alternatives for Generating Random Numbers
    http://support.microsoft.com/kb/28150/EN-US/

    ** Enhanced ciphers
    ********************************
    With all ciphers, except ArcFour, the data length will change. After
    encrytption, data sizes will not match original sizes. This is due to
    internal padding and the storing of information required to decrypt the
    data later.
    ********************************
    ** PASSWORDS
    ********************************
    Currently there is a minimum and maximum length of the password the user
    may enter. This can be changed in the kiCrypt DLL basCommon.bas module.
    In the declarations section, locate these two constants and make the
    desired change. Be sure to recompile the DLL and the demo application.
    PWD_LENGTH_MIN = 8
    PWD_LENGTH_MAX = 50
    If no hash algorithm is selected then the default hash will be SHA-256.

    Sources:
    http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=74645&lngWId=1
    http://www.vbforums.com/showthread.php?831741-How-do-I-use-Crypto-API-functionality-in-VB6-without-CAPICOM-ActiveX-control


    ↧

    Voronoi diagrams (by David Rutten)

    September 29, 2021, 1:07 am
    $
    0
    0
    Voronoi diagrams are named after Russian mathematician Georgy Feodosievych Voronoy who defined and studied the general n-dimensional case in 1908.

    Voronoi diagrams are quite useful tools in computational geometry and have a wide range of uses such as, calculating the area per tree in the forest, or figuring out where the poisoned wells were in a city (based on victims' addresses), and so on. In general it is useful for finding "who is closest to whom." A collection of problems where Voronoi diagrams are used is shown below:
    • Collision detection
    • Pattern recognition
    • Geographical optimization
    • Geometric clustering
    • Closest pairs algorithms
    • k-nearest-neighbor queries

    Download from ME
    Download from PSC













    Sources:
    https://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=57062&lngWId=1
    https://www.codeproject.com/Articles/411242/Create-a-Voronoi-diagram-1-of-2
    ↧
    Search

    Ant colony simulation (by David Rutten)

    October 20, 2021, 1:21 am
    ↧

    Access of Speed 6 - a 3D game with sources in VB6

    February 25, 2022, 6:50 am
    $
    0
    0

    Mikle again ! I have posted projects from Mikle in the past. If you don't know who Mikle is, well, he is the best 3D developer I have seen.I think his name is "Михаил Ильин", which translated is Mihail Ilyin. This Visual Basic 6.0 open source project is one of the most advanced NFS-like games I have seen.


    Download VB6 source code from Mikle: AoS6Src

    Download VB6 source code from me: AoS6Src


    Screenshots:




    References:

    https://www.vbforums.com/showthread.php?889979-Access-of-Speed-6-My-new-game

    ↧
    ↧

    Quake shooter - a 3D game with sources in VB6

    March 10, 2022, 6:54 am
    ↧

    PhotoDemon - the number one photo editor (VB6)

    April 4, 2022, 5:35 pm
    $
    0
    0

    This open source project is one of the most advanced photo editors in the world. Obviously it is made in Visual Basic 6.0! When I see a project like this I have to keep a moment of silence in sign of respect. The source code represents with no exaggeration, perfection.

    Download from Me

    Download from GitHub

    Photo Demon

    Lightweight and completely portable

    No installer is provided or required. Aside from a temporary folder – which you can specify in the Tools > Options menu – PhotoDemon leaves no trace on your hard drive. Many users run PhotoDemon from a USB stick or microSD card.

    Integrated macro recording and batch processing

    Complex editing actions can be recorded as macros (similar to Office software). A built-in batch processor lets you apply macros to entire folders of images.

    Usability is paramount

    Many open-source photo editors are usability nightmares. PhotoDemon tries not to be. Small touches like real-time effect previews, save/load presets on all tools, unlimited Undo/Redo, "Fade last action", keyboard accelerators, mouse wheel and X-button support, and descriptive icons make it fast and easy to use.

    Pro-grade features and tools

    • Extensive file format support, including Adobe Photoshop (PSD), Corel PaintShop Pro (PSP), and all major camera RAW formats
    • Color-managed workflow, including full support for embedded ICC profiles
    • Advanced multi-layer support, including editable text layers and non-destructive layer modifications
    • On-canvas tools: digital paintbrushes, clone and pattern brushes, interactive gradients, and more
    • Adjustment tools: levels, curves, HDR, shadow/highlight recovery, white balance, and many more
    • Filters and effects: perspective correction, edge detection, noise removal, content-aware blur, unsharp masking, green screen, lens diffraction, vignetting, and many more
    • More than 200 tools are provided in the current build.

    Limitation

    • PhotoDemon isn't designed for operating systems other than Microsoft Windows. A compatibility layer like Wine may allow it to work on macOS, Linux, or BSD systems, but these configurations are not officially supported.
    • Due to its portable nature, PhotoDemon is only available as a 32-bit application. (This means it cannot load or save images larger than ~2 GB in size.)

    File formats


    Effects


    Adjustments

    Image and Layer tools

    • All-new selection tool engine, including full support for merging selections. All selection tools support new "Add", "Subtract", and "Intersect" combine modes. In addition, a new canvas selection renderer automatically highlights the selected region of composite selections. (Other new rendering UI features are available on each selection toolpanel).
    • Completely redesigned Image > Resize tool, with real-time interactive previews, 12 different resampling filters, memory size estimations, a user-resizable dialog, progress bar updates, and more. The new tool was custom-built for PhotoDemon, and it has very low memory requirements, excellent performance, and zero 3rd-party dependencies. (The Layer > Resize tool also receives all of these new features!)
    • New Layer > Replace tools, for quickly replacing an existing layer with data from the clipboard or any arbitrary image file.
    • Overhauled Image > Crop tool, including new support for retaining editable text layers after cropping (instead of rasterizing them).
    • New lock aspect ratio toggle on the Move/Size tool
    Batch processor

    User interface

    Other

    For a full list of changes, check the project's commit log.

    ↧

    MSVBVM60.dll library - open source version in C++

    May 2, 2022, 6:13 pm
    ↧
    Viewing all 181 articles
    Browse latest View live
    Search